reactive-banana-wx 0.6.0.1 → 0.7.0.0
raw patch · 17 files changed
+183/−172 lines, 17 filesdep ~basedep ~containersdep ~processsetup-changednew-component:exe:BarTab
Dependency ranges changed: base, containers, process, reactive-banana, wx, wxcore
Files
- Makefile +3/−0
- Setup.hs +1/−1
- data/banana.png binary
- reactive-banana-wx.cabal +28/−71
- src/Animation.hs +2/−2
- src/Arithmetic.hs +2/−2
- src/Asteroids.hs +2/−2
- src/BarTab.hs +89/−0
- src/CRUD.hs +18/−19
- src/Counter.hs +2/−2
- src/CurrencyConverter.hs +2/−2
- src/NetMonitor.hs +2/−2
- src/Reactive/Banana/WX.hs +23/−21
- src/TicTacToe.hs +2/−2
- src/Tidings.hs +0/−40
- src/TwoCounters.hs +2/−2
- src/Wave.hs +5/−4
Makefile view
@@ -24,6 +24,9 @@ $(COMPILE) -o $@ $< -outputdir $(OBJ)/$@.tmp/ && macosx-app $@ \ && cp data/* $@.app/Contents/Resources +BarTab : src/BarTab.hs src/Reactive/Banana/WX.hs+ $(COMPILE) -o $@ $< -outputdir $(OBJ)/$@.tmp/ && macosx-app $@+ Counter : src/Counter.hs src/Reactive/Banana/WX.hs $(COMPILE) -o $@ $< -outputdir $(OBJ)/$@.tmp/ && macosx-app $@
Setup.hs view
@@ -15,7 +15,7 @@ [mkApp filesAsteroids "Asteroids", mkApp filesAnimation "Animation"] ++ apps apps = map (mkApp []) $- words "Arithmetic Counter CurrencyConverter CRUD"+ words "Arithmetic BarTab Counter CurrencyConverter CRUD" ++ words "NetMonitor TicTacToe TwoCounters Wave" filesAsteroids = map ("data/" ++) $ words "burning.ico rock.ico ship.ico explode.wav"
− data/banana.png
binary file changed (2013 → absent bytes)
reactive-banana-wx.cabal view
@@ -1,5 +1,5 @@ Name: reactive-banana-wx-Version: 0.6.0.1+Version: 0.7.0.0 Synopsis: Examples for the reactive-banana library, using wxHaskell. Description: This library provides some GUI examples for the @reactive-banana@ library,@@ -13,10 +13,6 @@ . @cabal install reactive-banana-wx -fbuildExamples@ .- IMPORTANT NOTE:- There are a few issues with WxWidgets 2.9.3 and some examples may crash.- These problems are only solved in wx-0.90.0.1 and higher.- . Stability forecast: The wrapper functions are rather provisional. Homepage: http://haskell.org/haskellwiki/Reactive-banana@@ -25,14 +21,14 @@ Author: Heinrich Apfelmus Maintainer: Heinrich Apfelmus <apfelmus quantentunnel de> Category: FRP, GUI-Cabal-version: >=1.8+Cabal-version: >=1.6 Build-type: Custom Extra-source-files: Makefile data-dir: data-data-files: *.ico, *.wav, *.png+data-files: *.ico, *.wav flag buildExamples description: Build example executables@@ -42,9 +38,8 @@ hs-source-dirs: src build-depends: base >= 4.2 && < 5, cabal-macosx >= 0.1 && < 0.3,- reactive-banana >= 0.6.0.0 && < 0.7,- wxcore (>= 0.13.2.1 && < 0.90) || (>= 0.90.0.1 && < 0.91),- wx (>= 0.13.2.1 && < 0.90) || (>= 0.90.0.1 && < 0.91)+ reactive-banana >= 0.7.0.0 && < 0.8,+ wx >= 0.90 && < 0.91, wxcore >= 0.90 && < 0.91 extensions: ExistentialQuantification exposed-modules: Reactive.Banana.WX @@ -55,17 +50,8 @@ Executable Animation if flag(buildExamples)- build-depends:- process >= 1.0 && < 1.2,- random == 1.0.*,- executable-path == 0.0.*,- filepath >= 1.1 && <= 1.4,- reactive-banana,- wx,- wxcore,- base- cpp-options: -DbuildExamples- + cpp-options: -DbuildExamples+ build-depends: reactive-banana, wx, wxcore, base else buildable: False hs-source-dirs: src@@ -74,12 +60,7 @@ Executable Arithmetic if flag(buildExamples)- build-depends:- process >= 1.0 && < 1.2,- reactive-banana,- wx,- wxcore,- base+ build-depends: reactive-banana, wx, wxcore, base else buildable: False hs-source-dirs: src@@ -91,10 +72,7 @@ random == 1.0.*, executable-path == 0.0.*, filepath >= 1.1 && <= 1.4,- reactive-banana,- wx,- wxcore,- base+ reactive-banana, wx, wxcore, base cpp-options: -DbuildExamples else buildable: False@@ -102,13 +80,17 @@ other-modules: Paths_reactive_banana_wx, Paths main-is: Asteroids.hs +Executable BarTab+ if flag(buildExamples)+ build-depends: reactive-banana, wx, wxcore, base+ else+ buildable: False+ hs-source-dirs: src+ main-is: BarTab.hs+ Executable Counter if flag(buildExamples)- build-depends:- reactive-banana,- wx,- wxcore,- base+ build-depends: reactive-banana, wx, wxcore, base else buildable: False hs-source-dirs: src@@ -116,12 +98,8 @@ Executable CurrencyConverter if flag(buildExamples)- build-depends:- process >= 1.0.1 && < 1.2,- reactive-banana,- wx,- wxcore,- base+ build-depends: process >= 1.0.1 && < 1.2,+ reactive-banana, wx, wxcore, base else buildable: False hs-source-dirs: src@@ -129,26 +107,17 @@ Executable CRUD if flag(buildExamples)- build-depends:- containers >= 0.3 && < 0.6,- reactive-banana,- wx,- wxcore,- base+ build-depends: containers >= 0.3 && < 0.5,+ reactive-banana, wx, wxcore, base else buildable: False hs-source-dirs: src main-is: CRUD.hs- other-modules: Tidings Executable NetMonitor if flag(buildExamples)- build-depends:- process >= 1.0 && < 1.2,- reactive-banana,- wx,- wxcore,- base+ build-depends: process >= 1.0 && < 1.2,+ reactive-banana, wx, wxcore, base else buildable: False hs-source-dirs: src@@ -156,12 +125,8 @@ Executable TicTacToe if flag(buildExamples)- build-depends:- array >= 0.3 && < 0.5,- reactive-banana,- wx,- wxcore,- base+ build-depends: array >= 0.3 && < 0.5,+ reactive-banana, wx, wxcore, base else buildable: False hs-source-dirs: src@@ -169,11 +134,7 @@ Executable TwoCounters if flag(buildExamples)- build-depends:- reactive-banana,- wx,- wxcore,- base+ build-depends: reactive-banana, wx, wxcore, base else buildable: False hs-source-dirs: src@@ -181,11 +142,7 @@ Executable Wave if flag(buildExamples)- build-depends:- reactive-banana,- wx,- wxcore,- base+ build-depends: reactive-banana, wx, wxcore, base else buildable: False hs-source-dirs: src
src/Animation.hs view
@@ -3,7 +3,7 @@ Example: A simple animation. ------------------------------------------------------------------------------}-{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. NetworkDescription t"+{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t" import Graphics.UI.WX hiding (Event, Vector) import Reactive.Banana@@ -43,7 +43,7 @@ set ff [ layout := minsize (sz width height) $ widget pp ] -- event network- let networkDescription :: forall t. NetworkDescription t ()+ let networkDescription :: forall t. Frameworks t => Moment t () networkDescription = do etick <- event0 t command -- frame timer emouse <- event1 pp mouse -- mouse events
src/Arithmetic.hs view
@@ -3,7 +3,7 @@ Example: Very simple arithmetic ------------------------------------------------------------------------------}-{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. NetworkDescription t"+{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t" import Data.Maybe @@ -24,7 +24,7 @@ [widget input1, label "+", widget input2 , label "=", minsize (sz 40 20) $ widget output]] - let networkDescription :: forall t. NetworkDescription t ()+ let networkDescription :: forall t. Frameworks t => Moment t () networkDescription = do binput1 <- behaviorText input1 ""
src/Asteroids.hs view
@@ -11,7 +11,7 @@ https://github.com/killerswan/wxAsteroids/issues/1 http://comments.gmane.org/gmane.comp.lang.haskell.wxhaskell.general/1086 ------------------------------------------------------------------------------}-{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. NetworkDescription t"+{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t" import Graphics.UI.WX hiding (Event) import Graphics.UI.WXCore as WXCore@@ -81,7 +81,7 @@ ] -- event network- let networkDescription :: forall t. NetworkDescription t ()+ let networkDescription :: forall t. Frameworks t => Moment t () networkDescription = do -- timer etick <- event0 t command
+ src/BarTab.hs view
@@ -0,0 +1,89 @@+{-----------------------------------------------------------------------------+ reactive-banana-wx+ + Example: Bar tab with a variable number of widgets+------------------------------------------------------------------------------}+{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t"+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}++import Data.Maybe (listToMaybe)++import Graphics.UI.WX hiding (Event)+import Reactive.Banana+import Reactive.Banana.WX++import Data.Traversable (sequenceA)++{-----------------------------------------------------------------------------+ Main+------------------------------------------------------------------------------}+main = start $ do+ f <- frame [text := "Bar Tab"]+ msg <- staticText f [ text := "Sum:" ]+ total <- staticText f []+ add <- button f [text := "Add"]+ remove <- button f [text := "Remove"]+ + let networkDescription :: forall t. Frameworks t => Moment t ()+ networkDescription = do+ eAdd <- event0 add command+ eRemove <- event0 remove command+ + let+ newEntry :: Frameworks s+ => Moment s (TextCtrl (), AnyMoment Behavior String) + newEntry = do+ wentry <- liftIONow $ entry f []+ bentry <- trimB =<< behaviorText wentry ""+ return (wentry, bentry)+ + eNewEntry <- execute $ (FrameworksMoment newEntry <$ eAdd)+ + let+ eDoRemove = whenE (not . null <$> bEntries) eRemove+ + eEntries :: Event t [(TextCtrl (), AnyMoment Behavior String)]+ eEntries = accumE [] $+ ((\x -> (++ [x])) <$> eNewEntry) `union` (init <$ eDoRemove)+ + bEntries = stepper [] eEntries+ + reactimate $ ((\w -> set w [ visible := False]) . fst . last)+ <$> bEntries <@ eDoRemove+ + let+ ePrices :: Event t [AnyMoment Behavior Number]+ ePrices = map (fmap readNumber . snd) <$> eEntries+ + bLayout :: Behavior t Layout+ bLayout = mkLayout . map fst <$> bEntries+ + mkLayout entries = margin 10 $ column 10 $+ [row 10 [widget add, widget remove]] ++ map widget entries+ ++ [row 10 $ [widget msg, minsize (sz 40 20) $ widget total]]+ + bTotal :: Behavior t Number+ bTotal = switchB (pure Nothing) $+ (fmap sum . sequenceA) <$> ePrices++ sink total [text :== showNumber <$> bTotal]+ sink f [layout :== bLayout]+ + network <- compile networkDescription + actuate network++{-----------------------------------------------------------------------------+ Utilities+------------------------------------------------------------------------------}+type Number = Maybe Double++instance Num Number where+ (+) = liftA2 (+)+ (-) = liftA2 (-)+ (*) = liftA2 (*)+ abs = fmap abs+ signum = fmap signum+ fromInteger = pure . fromInteger++readNumber s = listToMaybe [x | (x,"") <- reads s] +showNumber = maybe "--" show
src/CRUD.hs view
@@ -7,7 +7,7 @@ that the database is updated. This is perfectly fine for rapid prototyping. A more sophisticated approach would use incremental updates. ------------------------------------------------------------------------------}-{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. NetworkDescription t"+{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t" {-# LANGUAGE RecursiveDo, NoMonomorphismRestriction #-} import Prelude hiding (lookup)@@ -49,7 +49,7 @@ ]] -- event network- let networkDescription :: forall t. NetworkDescription t ()+ let networkDescription :: forall t. Frameworks t => Moment t () networkDescription = mdo -- events from buttons eCreate <- event0 createBtn command @@ -60,15 +60,14 @@ tFilter = isPrefixOf <$> tFilterString bFilter = facts tFilter eFilter = rumors tFilter- + -- list box with selection eSelection <- rumors <$> reactiveListDisplay listBox bListBoxItems bSelection bShowDataItem- -- data item display eDataItemIn <- rumors <$> reactiveDataItem (firstname,lastname) bSelectionDataItem- + let -- database bDatabase :: Behavior t (Database DataItem) bDatabase = accumB emptydb $ unions@@ -106,6 +105,7 @@ let bDisplayItem :: Behavior t Bool bDisplayItem = maybe False (const True) <$> bSelection+ sink deleteBtn [ enabled :== bDisplayItem ] sink firstname [ enabled :== bDisplayItem ] sink lastname [ enabled :== bDisplayItem ]@@ -134,11 +134,10 @@ showDataItem (firstname, lastname) = lastname ++ ", " ++ firstname -- single text entry-reactiveTextEntry- :: TextCtrl a- -> Behavior t String -- text value- -> NetworkDescription t- (Tidings t String) -- user changes+reactiveTextEntry :: Frameworks t+ => TextCtrl a+ -> Behavior t String -- text value+ -> Moment t (Tidings t String) -- user changes reactiveTextEntry w btext = do eUser <- eventText w -- user changes @@ -152,11 +151,10 @@ return $ tidings btext eUser -- whole data item (consisting of two text entries)-reactiveDataItem- :: (TextCtrl a, TextCtrl b)+reactiveDataItem :: Frameworks t+ => (TextCtrl a, TextCtrl b) -> Behavior t (Maybe DataItem)- -> NetworkDescription t- (Tidings t DataItem)+ -> Moment t (Tidings t DataItem) reactiveDataItem (firstname,lastname) binput = do t1 <- reactiveTextEntry firstname (fst . maybe ("","") id <$> binput) t2 <- reactiveTextEntry lastname (snd . maybe ("","") id <$> binput)@@ -171,17 +169,18 @@ Changing the set may unselect the current item, but will not change it to another item. ------------------------------------------------------------------------------}-reactiveListDisplay :: forall t a b. Ord a+reactiveListDisplay :: forall t a b. (Ord a, Frameworks t) => SingleListBox b -- ListBox widget to use -> Behavior t [a] -- list of items -> Behavior t (Maybe a) -- selected element -> Behavior t (a -> String) -- display an item- -> NetworkDescription t+ -> Moment t (Tidings t (Maybe a)) -- current selection as item (possibly empty) reactiveListDisplay w bitems bsel bdisplay = do -- animate output items+ liftIONow $ putStrLn "test" sink w [ items :== map <$> bdisplay <*> bitems ]-+ -- animate output selection let bindices :: Behavior t (Map.Map a Int) bindices = (Map.fromList . flip zip [0..]) <$> bitems@@ -206,7 +205,7 @@ {- Currently exported from Reactive.Banana.WX -- user input event - text for text entries-eventText :: TextCtrl w -> NetworkDescription t (Event t String)+eventText :: TextCtrl w -> Moment t (Event t String) eventText w = do -- Should probably be wxEVT_COMMAND_TEXT_UPDATED , -- but that's missing from wxHaskell.@@ -220,7 +219,7 @@ keyboardUp = WX.newEvent "keyboardUp" WXCore.windowGetOnKeyUp WXCore.windowOnKeyUp -- user input event - selection marker for list events-eventSelection :: SingleListBox b -> NetworkDescription t (Event t Int)+eventSelection :: SingleListBox b -> Moment t (Event t Int) eventSelection w = do liftIO $ fixSelectionEvent w addHandler <- liftIO $ event1ToAddHandler w (event0ToEvent1 select)
src/Counter.hs view
@@ -3,7 +3,7 @@ Example: Counter ------------------------------------------------------------------------------}-{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. NetworkDescription t"+{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t" import Control.Monad @@ -23,7 +23,7 @@ set f [layout := margin 10 $ column 5 [widget bup, widget bdown, widget output]] - let networkDescription :: forall t. NetworkDescription t ()+ let networkDescription :: forall t. Frameworks t => Moment t () networkDescription = do eup <- event0 bup command
src/CurrencyConverter.hs view
@@ -3,7 +3,7 @@ Example: Currency Converter ------------------------------------------------------------------------------}-{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. NetworkDescription t"+{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t" {-# LANGUAGE RecursiveDo #-} import Data.Bits@@ -30,7 +30,7 @@ , label "Amounts update while typing." ]] - let networkDescription :: forall t. NetworkDescription t ()+ let networkDescription :: forall t. Frameworks t => Moment t () networkDescription = do euroIn <- behaviorText euro "0"
src/NetMonitor.hs view
@@ -3,7 +3,7 @@ Example: Minuscule network monitor ------------------------------------------------------------------------------}-{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. NetworkDescription t"+{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t" import Data.Char import Data.List@@ -32,7 +32,7 @@ t <- timer f [ interval := 500 ] -- timer every 500 ms - let networkDescription :: forall t. NetworkDescription t ()+ let networkDescription :: forall t. Frameworks t => Moment t () networkDescription = do -- The network statistics are polled when and only when -- the event network handles an event.
src/Reactive/Banana/WX.hs view
@@ -11,6 +11,7 @@ -- * General event1, event0, behavior, Prop'(..), sink,+ module Reactive.Banana.Frameworks, -- * Specific widgets eventText, behaviorText, eventSelection,@@ -21,6 +22,8 @@ ) where import Reactive.Banana+import Reactive.Banana.Frameworks+ import qualified Graphics.UI.WX as WX import Graphics.UI.WX hiding (Event, Attr) import qualified Graphics.UI.WXCore as WXCore@@ -30,9 +33,10 @@ General ------------------------------------------------------------------------------} -- | Event with exactly one parameter.-event1 :: w -> WX.Event w (a -> IO ()) -> NetworkDescription t (Event t a)+event1 :: Frameworks t =>+ w -> WX.Event w (a -> IO ()) -> Moment t (Event t a) event1 widget e = do- addHandler <- liftIO $ event1ToAddHandler widget e+ addHandler <- liftIONow $ event1ToAddHandler widget e fromAddHandler addHandler -- NOTE: Some events don't work, for instance leftKey and rightKey@@ -41,13 +45,15 @@ -- Not sure what to do with this. -- | Event without parameters.-event0 :: w -> WX.Event w (IO ()) -> NetworkDescription t (Event t ())+event0 :: Frameworks t =>+ w -> WX.Event w (IO ()) -> Moment t (Event t ()) event0 widget = event1 widget . event0ToEvent1 -- | Behavior from an attribute. -- Uses 'fromPoll', so may behave as you expect.-behavior :: w -> WX.Attr w a -> NetworkDescription t (Behavior t a)-behavior widget attr = fromPoll . liftIO $ get widget attr+behavior :: Frameworks t =>+ w -> WX.Attr w a -> Moment t (Behavior t a)+behavior widget attr = fromPoll $ get widget attr -- | Variant of wx properties that accept a 'Behavior'. data Prop' t w = forall a. (WX.Attr w a) :== Behavior t a@@ -55,7 +61,8 @@ infixr 0 :== -- | "Animate" a property with a behavior-sink :: w -> [Prop' t w] -> NetworkDescription t ()+sink :: Frameworks t =>+ w -> [Prop' t w] -> Moment t () sink widget props = mapM_ sink1 props where sink1 (attr :== b) = do@@ -69,9 +76,10 @@ ------------------------------------------------------------------------------} -- | Event that occurs when the /user/ changed -- the text in text edit widget.-eventText :: TextCtrl w -> NetworkDescription t (Event t String)+eventText :: Frameworks t =>+ TextCtrl w -> Moment t (Event t String) eventText w = do- addHandler <- liftIO $ event1ToAddHandler w (event0ToEvent1 onText)+ addHandler <- liftIONow $ event1ToAddHandler w (event0ToEvent1 onText) fromAddHandler $ filterAddHandler (const $ WXCore.textCtrlIsModified w) $ mapIO (const $ get w text) addHandler@@ -85,20 +93,22 @@ -- keyboardUp = WX.newEvent "keyboardUp" WXCore.windowGetOnKeyUp WXCore.windowOnKeyUp -- | Behavior corresponding to user input the text field.-behaviorText :: TextCtrl w -> String -> NetworkDescription t (Behavior t String)+behaviorText :: Frameworks t =>+ TextCtrl w -> String -> Moment t (Behavior t String) behaviorText w s = stepper s <$> eventText w -- | Event that occurs when the /user/ changed -- the selection marker in a list box widget.-eventSelection :: SingleListBox b -> NetworkDescription t (Event t Int)+eventSelection :: Frameworks t =>+ SingleListBox b -> Moment t (Event t Int) eventSelection w = do- liftIO $ fixSelectionEvent w- addHandler <- liftIO $ event1ToAddHandler w (event0ToEvent1 select)+ liftIONow $ fixSelectionEvent w+ addHandler <- liftIONow $ event1ToAddHandler w (event0ToEvent1 select) fromAddHandler $ mapIO (const $ get w selection) addHandler -- Fix @select@ event not being fired when items are *un*selected. fixSelectionEvent listbox =- liftIO $ set listbox [ on unclick := handler ]+ set listbox [ on unclick := handler ] where handler _ = do propagateEvent@@ -120,11 +130,3 @@ event0ToEvent1 :: WX.Event w (IO ()) -> WX.Event w (() -> IO ()) event0ToEvent1 = mapEvent const (\_ e -> e ()) --- | Apply a function with side effects to an 'AddHandler'-mapIO :: (a -> IO b) -> AddHandler a -> AddHandler b-mapIO f addHandler = \h -> addHandler $ \x -> f x >>= h ---- | Filter event occurrences that don't return 'True'.-filterAddHandler :: (a -> IO Bool) -> AddHandler a -> AddHandler a-filterAddHandler f addHandler = \h ->- addHandler $ \x -> f x >>= \b -> if b then h x else return ()
src/TicTacToe.hs view
@@ -4,7 +4,7 @@ Example: A version of TicTacToe with eclectic interface elements Original Author: Gideon Sireling ------------------------------------------------------------------------------} -{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. NetworkDescription t" +{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t" import Control.Monad import Data.Array @@ -35,7 +35,7 @@ [map widget btns, map widget radios, map widget checks] , floatCenter $ widget label]] - let networkDescription :: forall t. NetworkDescription t () + let networkDescription :: forall t. Frameworks t => Moment t () networkDescription = do -- convert WxHaskell events to FRP events let event0s widgets event = forM widgets $ \x -> event0 x event
− src/Tidings.hs
@@ -1,40 +0,0 @@-{------------------------------------------------------------------------------ reactive-banana-------------------------------------------------------------------------------}-module Tidings (- -- * Synopsis- -- The 'Tidings' data type for composing user events.- --- -- See <http://apfelmus.nfshost.com/blog/2012/03/29-frp-three-principles-bidirectional-gui.html>- -- for more information.- - -- * Documentation- Tidings, tidings, facts, rumors,- ) where--import Reactive.Banana.Combinators---- | Data type representing a behavior 'facts'--- and suggestions to change it 'rumors'.-data Tidings t a = T { facts :: Behavior t a, rumors :: Event t a }---- | Smart constructor. Combine facts and rumors into 'Tidings'.-tidings :: Behavior t a -> Event t a -> Tidings t a-tidings b e = T b (calm e)--instance Functor (Tidings t) where- fmap f (T b e) = T (fmap f b) (fmap f e)---- | The applicative instance combines 'rumors'--- and uses 'facts' when some of the 'rumors' are not available.-instance Applicative (Tidings t) where- pure x = T (pure x) never- f <*> x = uncurry ($) <$> pair f x--pair :: Tidings t a -> Tidings t b -> Tidings t (a,b)-pair (T bx ex) (T by ey) = T b e- where- b = (,) <$> bx <*> by- x = flip (,) <$> by <@> ex- y = (,) <$> bx <@> ey- e = unionWith (\(x,_) (_,y) -> (x,y)) x y
src/TwoCounters.hs view
@@ -3,7 +3,7 @@ Example: Two Counters. ------------------------------------------------------------------------------}-{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. NetworkDescription t"+{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t" import Control.Monad @@ -27,7 +27,7 @@ grid 5 5 [[label "First Counter:" , widget out1] ,[label "Second Counter:", widget out2]]]] - let networkDescription :: forall t. NetworkDescription t ()+ let networkDescription :: forall t. Frameworks t => Moment t () networkDescription = do eup <- event0 bup command
src/Wave.hs view
@@ -5,7 +5,7 @@ Demonstrates that reactive-banana is capable of emitting timed events, even though it has no built-in notion of time. ------------------------------------------------------------------------------}-{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. NetworkDescription t"+{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t" import Control.Monad import qualified Data.List as List@@ -38,7 +38,7 @@ -- we're going to need a timer t <- timer f [] - let networkDescription :: forall t. NetworkDescription t ()+ let networkDescription :: forall t. Frameworks t => Moment t () networkDescription = do eLeft <- event0 left command@@ -90,9 +90,10 @@ -- Schedule events to happen after a given duration from their occurrence -- However, new events will *not* be scheduled before the old ones have finished.-scheduleQueue :: Timer -> Event t (Enqueue a) -> NetworkDescription t (Event t a)+scheduleQueue :: Frameworks t =>+ Timer -> Event t (Enqueue a) -> Moment t (Event t a) scheduleQueue t e = do- liftIO $ set t [ enabled := False ]+ liftIONow $ set t [ enabled := False ] eAlarm <- event0 t command let -- (Queue that keeps track of events to schedule