diff --git a/App/Behaviours/PrintEvents.hs b/App/Behaviours/PrintEvents.hs --- a/App/Behaviours/PrintEvents.hs +++ b/App/Behaviours/PrintEvents.hs @@ -6,6 +6,7 @@ import System.Locale import App.EventBus +printEventsBehaviour :: Behaviour [EData a] printEventsBehaviour b = pollAllEventsWith b $ (\(Event n g lifetime edata source t) -> do putStrLn.render $ text "name: " <+> text n $+$ text "source: " <+> text source $+$ diff --git a/App/EventBus.hs b/App/EventBus.hs --- a/App/EventBus.hs +++ b/App/EventBus.hs @@ -91,7 +91,7 @@ { name :: 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 :: [EData a] -- ^ The data attached to the event. + , eventdata :: a -- ^ The data attached to the event. , src :: String -- ^ The behaviour or widget that assigned the event to time. , time :: UTCTime } -- ^ The time of the event's inception. @@ -202,12 +202,12 @@ Just m -> putMVar b . expire =<< decrementTimeSpan =<< applyDiff m =<< behaviour m -- | Assign an event to time given some event data and a TimeSpan. -produce :: String -> String -> String -> TimeSpan -> [EData a] -> IO (Diff a) +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' :: String -> String -> String -> TimeSpan -> [EData a] -> MVar (Bus a) -> IO () +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 diff --git a/App/Widgets/Environment.hs b/App/Widgets/Environment.hs new file mode 100644 --- /dev/null +++ b/App/Widgets/Environment.hs @@ -0,0 +1,92 @@ +module App.Widgets.Environment where + +import Control.Monad +import Data.Either +import Data.List (elem) +import App.EventBus +import System.Environment +import Data.Maybe +import Text.Parsec hiding (many) +import Control.Applicative + +isNotBlankLine = (/=0) . length . filter (/=' ') . filter (/='\t') +isNotCommentLine = not . elem ' ' +hasValue = elem '=' +parseConfigLine = liftA2 (,) (spaces *> many1 alphaNum <* spaces) (spaces *> char '=' *> many anyChar) + +-- | Place the command line arguments on the bus as an Event following the pattern +-- +-- * name : argv +-- +-- * group : Environment +-- +-- * source : CommandLineArgsWidget +-- +-- * timespan : Persistent +-- +-- * data : EStringL of the command line args +commandLineArgsWidget :: Widget [EData a] +commandLineArgsWidget b = getArgs >>= + \args -> produce' "Environment" "CommandLineArgsWidget" "argv" Persistent [EStringL args] b + +-- | Read a config file and place it on the bus as individual events for each config item following the pattern: +-- +-- * name : config item name +-- +-- * group : Environment +-- +-- * source : /filename/.ConfigFileWidget +-- +-- * timespan : Persistent +-- +-- * data : EString config item value +-- +-- Config files follow a fairly simple grammar: +-- +-- ConfigFile := [ConfigLine] +-- +-- ConfigLine := spaces = spaces endl | CommentLine | BlankLine +-- +-- CommentLine := # anychars endl +-- +-- BlankLine := spaces endl +configFileWidget :: String -> Widget [EData a] +configFileWidget f b = configLines >>= mapM_ produceConfigDataEvent + where produceConfigDataEvent (n,v) = produce' "Environment" (f ++ ".ConfigFileWidget") n Persistent [EString v] b + configLines = rights . map (parse parseConfigLine "(Unknown line in config file)") + . filter isNotBlankLine + . filter isNotCommentLine + . filter hasValue + . lines + <$> readFile f + +-- | Read in all environment variables and place them on the bus individually as events following the pattern: +-- +-- * name : variable name +-- +-- * group : Environment +-- +-- * source : EnvironmentWidget +-- +-- * timespan : Persistent +-- +-- * data : EString variable value +-- +environmentWidget :: Widget [EData a] +environmentWidget b = getEnvironment >>= + mapM_ (\(k,v) -> produce' "Environment" "EnvironmentWidget" k Persistent [EString v] b) + +-- | Set the program name as an event on the bus using the following pattern: +-- +-- * name : ProgramName +-- +-- * group : Environment +-- +-- * source : ProgramNameWidget +-- +-- * timespan : Persistent +-- +-- * data : EString progran name +progNameWidget :: Widget [EData a] +progNameWidget b = getProgName >>= + \v -> produce' "Environment" "ProgramNameWidget" "ProgramName" Persistent [EString v] b diff --git a/App/Widgets/GtkMouseKeyboard.hs b/App/Widgets/GtkMouseKeyboard.hs --- a/App/Widgets/GtkMouseKeyboard.hs +++ b/App/Widgets/GtkMouseKeyboard.hs @@ -41,7 +41,7 @@ return False -- | Bind a keyboard mouse widget to the given Gtk widget. Se module documentation for description of events. -bindMouseKeyboardWidget :: Gtk.Widget -> Widget a +bindMouseKeyboardWidget :: Gtk.Widget -> Widget [EData a] bindMouseKeyboardWidget w b = do ref <- newEmptyMVar wname <- Gtk.widgetGetName w diff --git a/buster.cabal b/buster.cabal --- a/buster.cabal +++ b/buster.cabal @@ -1,5 +1,5 @@ name: buster -version: 0.99.1 +version: 0.99.2 cabal-version: -any build-type: Simple license: BSD3 @@ -8,7 +8,7 @@ maintainer: Jeff Heard build-depends: old-locale -any, time -any, containers -any, base -any, bytestring -any, gtk -any, mtl -any, - pretty -any + pretty -any, parsec >= 3.0.0 stability: Experimental homepage: http://vis.renci.org/jeff/buster package-url: @@ -33,7 +33,7 @@ extra-source-files: extra-tmp-files: exposed-modules: App.EventBus App.Behaviours.PrintEvents - App.Widgets.GtkMouseKeyboard + App.Widgets.GtkMouseKeyboard App.Widgets.Environment exposed: True buildable: True build-tools: