buster 0.99.5 → 0.99.6
raw patch · 5 files changed
+93/−16 lines, 5 filesdep +HTTPdep +network
Dependencies added: HTTP, network
Files
- App/Behaviours/FileOps.hs +9/−8
- App/Behaviours/HTTP.hs +62/−0
- App/EventBus.hs +2/−0
- App/Widgets/GtkMouseKeyboard.hs +14/−2
- buster.cabal +6/−6
App/Behaviours/FileOps.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} -- | 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.@@ -32,7 +33,7 @@ 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 . (:[])+ emitException e (ex :: Ex.SomeException) = 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@@ -56,7 +57,7 @@ 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 . (:[])+ emitException e (ex :: Ex.SomeException) = 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@@ -80,7 +81,7 @@ 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 . (:[])+ emitException e (ex :: Ex.SomeException) = 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@@ -103,7 +104,7 @@ 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 . (:[])+ emitException e (ex :: Ex.SomeException) = 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@@ -113,7 +114,7 @@ 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 . (:[]))+ (\(ex :: Ex.SomeException) -> 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@@ -124,7 +125,7 @@ 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 . (:[]))+ (\(ex :: Ex.SomeException) -> 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@@ -135,7 +136,7 @@ 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 . (:[]))+ (\(ex :: Ex.SomeException) -> 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@@ -146,7 +147,7 @@ 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 . (:[]))+ (\(ex :: Ex.SomeException) -> 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)
+ App/Behaviours/HTTP.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE ScopedTypeVariables #-}+-----------------------------------------------------------------------------+--+-- Module : App.Behaviours.HTTP+-- Copyright : 2009 Renaissance Computing Institute+-- License : BSD3+--+-- Maintainer : Jeff Heard <jeff@renci.org>+-- Stability : Experimental+-- Portability :+--+-- | Behaviours for HTTP GET and POST requests. Looks for Events named+-- HTTP\//MethodName/ with event data of [EString uri, EByteString senddata, EStringL headers] and consumes them. Produces+-- Events named HTTPResponse with source httpBehaviour\//MethodName/ and the contents of the response as the event data in a ByteString.+-- They also produce Exceptions with the same source and name ConnectionError if there is no network connection or HTTP Service+-- or HTTPErrorResponseCode if the Server sent back an error code or ParseFailure if the URI didn't parse.+--+-----------------------------------------------------------------------------++module App.Behaviours.HTTP (+++) where++import Control.Applicative ((<$>))+import App.EventBus+import Network.HTTP.HandleStream+import Network.HTTP+import Network.URI+import Network.Stream+import qualified Data.ByteString as BS++maybeHead (x:xs) = Just x+maybeHead [] = Nothing++httpBehaviour :: RequestMethod -> Behaviour [EData a]+httpBehaviour method b = consumeNamedEventsWith b ("HTTP/" ++ show method) $ \evt ->+ let EString uriS = head . eventdata $ evt+ postdata = maybe BS.empty (\(EByteString getdata) -> getdata) . maybeHead . tail . eventdata $ evt+ postheaders = headers . tail . tail . eventdata $ evt++ headers (EString nm:EString val:hs) = Header (HdrCustom nm) val : headers hs+ headers [] = []++ httpGet uri = (simpleHTTP $ Request uri method postheaders postdata) >>=+ either (\_ -> produce "Exception" ("httpBehaviour" ++ show method) "ConnectionError" once [])+ (\(Response code reason rspheaders contents) ->+ case code of+ (1,_,_) -> produce "HTTPResponse" ("httpBehaviour/" ++ show method) (show uri) Persistent [EByteString contents]+ (2,_,_) -> produce "HTTPResponse" ("httpBehaviour/" ++ show method) (show uri) Persistent [EByteString contents]+ _ -> produce "Exception" ("httpBehaviour/" ++ show method) "HTTPErrorResponseCode" once [EString (show code), EStringL . map show $ rspheaders, EByteString contents])+++ in case parseURI uriS of+ Just uri -> listM $ httpGet uri+ Nothing -> listM $ produce "Exception" ("httpBehaviour" ++ show method) "ParseFailure" once [EString uriS]++++++
App/EventBus.hs view
@@ -348,6 +348,8 @@ current Persistent = True current (Iterations x) = x > 0 +listM v = v >>= return . (:[]) + {- example usage... - - handleDataLoad :: Behaviour
App/Widgets/GtkMouseKeyboard.hs view
@@ -1,12 +1,18 @@ -- | Gtk mouse keyboard widget. -- -- For a mouse button press or release, add events named SingleClick or ClickRelease respectively to the bus.--- For this widget, all events have source ''KeyboardMouseWidget'', and group ''Mouse''+-- For this widget, all events have source \"KeyboardMouseWidget\", and group \"Mouse\" -- Additionally, the data attached to the event follows the form [EString SingleClick|ClickRelease, EDouble x, EDouble y, EStringL [Gtk modifier names]] -- -- For a keyboard press or release, add events named KeyDown or KeyUp respectively to the bus. -- All keyboard events have group ''Keyboard'' and source ''WidgetName.KeyboardMouseWidget'' -- Additionally, the data attached to a keyboard event follows the form [EString keyName | EChar keyChar, EStringL [Gtk modifier names]]+--+-- For a tablet proximity, add events named \"Proximity\" with source WidgetName.KeyboardMouseWidget, group \"Mouse\" and with attached data+-- [EBool True] for the tablet is in proximity and [EBool False] for the tablet is out of proximity.+--+-- For mouse motion, add events named \"Position\" with group \"Mouse\" and attached data [EDouble x, EDouble y, EStringL modifiers]+-- module App.Widgets.GtkMouseKeyboard where import Control.Applicative@@ -35,11 +41,15 @@ return False motionHandler wname w b evt = do- produce' "Mouse" (wname ++ ".KeyboardMouseWidget") "Position" once [EDouble . Gtk.eventX $ evt, EDouble . Gtk.eventY $ evt] b+ produce' "Mouse" (wname ++ ".KeyboardMouseWidget") "Position" once [EDouble . Gtk.eventX $ evt, EDouble . Gtk.eventY $ evt, EStringL . map show . Gtk.eventModifier $ evt] b dwin <- Gtk.widgetGetDrawWindow w Gtk.drawWindowGetPointer dwin return False +proximityHandler wname b evt = do+ produce' "Mouse" (wname ++ ".KeyboardMouseWidget") "Proximity" once [EBool . Gtk.eventInContact $ evt] b+ return False+ -- | Bind a keyboard mouse widget to the given Gtk widget. Se module documentation for description of events. bindMouseKeyboardWidget :: Gtk.Widget -> Widget [EData a] bindMouseKeyboardWidget w b = do@@ -51,4 +61,6 @@ Gtk.onKeyPress w (keyboardHandler wname b) Gtk.onKeyRelease w (keyboardHandler wname b) Gtk.onMotionNotify w True (motionHandler wname w b)+ Gtk.onProximityIn w (proximityHandler wname b)+ Gtk.onProximityOut w (proximityHandler wname b) return ()
buster.cabal view
@@ -1,20 +1,20 @@ name: buster-version: 0.99.5+version: 0.99.6 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,- gtk -any, bytestring -any, base -any, containers -any, time -any,- old-locale -any+build-depends: network -any, HTTP >=4000.0, 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: bug-reports: synopsis: Almost but not quite entirely unlike FRP-description: Buster is best described by the following blog post: http://vis.renci.org/jeff/2009/03/31/almost-but-not-quite-entirely-like-frp/+description: Buster is best described by the following blog post: http:\/\/vis.renci.org\/jeff\/2009\/03\/31\/almost-but-not-quite-entirely-like-frp\/ . It is an engine for orchestrating large, complex, and multifaceted applications by couching them in terms of time, events, a bus, behaviours, and widgets. Time is continuous and infininte. Events are discrete and exist for a particular time. The bus is a@@ -33,7 +33,7 @@ extra-source-files: extra-tmp-files: exposed-modules: App.EventBus App.Behaviours.PrintEvents- App.Behaviours.Exception App.Behaviours.FileOps+ App.Behaviours.Exception App.Behaviours.FileOps App.Behaviours.HTTP App.Widgets.GtkMouseKeyboard App.Widgets.Environment exposed: True buildable: True