diff --git a/data/banana.png b/data/banana.png new file mode 100644 Binary files /dev/null and b/data/banana.png differ diff --git a/reactive-banana-wx.cabal b/reactive-banana-wx.cabal --- a/reactive-banana-wx.cabal +++ b/reactive-banana-wx.cabal @@ -1,5 +1,5 @@ Name: reactive-banana-wx -Version: 0.7.0.0 +Version: 0.7.1.0 Synopsis: Examples for the reactive-banana library, using wxHaskell. Description: This library provides some GUI examples for the @reactive-banana@ library, @@ -21,14 +21,14 @@ Author: Heinrich Apfelmus Maintainer: Heinrich Apfelmus Category: FRP, GUI -Cabal-version: >=1.6 +Cabal-version: >=1.8 Build-type: Custom Extra-source-files: Makefile data-dir: data -data-files: *.ico, *.wav +data-files: *.ico, *.wav, *.png flag buildExamples description: Build example executables @@ -38,8 +38,9 @@ hs-source-dirs: src build-depends: base >= 4.2 && < 5, cabal-macosx >= 0.1 && < 0.3, - reactive-banana >= 0.7.0.0 && < 0.8, - wx >= 0.90 && < 0.91, wxcore >= 0.90 && < 0.91 + reactive-banana >= 0.7.1.0 && < 0.8, + 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) extensions: ExistentialQuantification exposed-modules: Reactive.Banana.WX @@ -50,8 +51,13 @@ Executable Animation if flag(buildExamples) - cpp-options: -DbuildExamples - build-depends: reactive-banana, wx, wxcore, base + 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 else buildable: False hs-source-dirs: src @@ -98,8 +104,7 @@ Executable CurrencyConverter if flag(buildExamples) - build-depends: process >= 1.0.1 && < 1.2, - reactive-banana, wx, wxcore, base + build-depends: reactive-banana, wx, wxcore, base else buildable: False hs-source-dirs: src @@ -113,6 +118,7 @@ buildable: False hs-source-dirs: src main-is: CRUD.hs + other-modules: Tidings Executable NetMonitor if flag(buildExamples) diff --git a/src/BarTab.hs b/src/BarTab.hs --- a/src/BarTab.hs +++ b/src/BarTab.hs @@ -33,7 +33,7 @@ newEntry :: Frameworks s => Moment s (TextCtrl (), AnyMoment Behavior String) newEntry = do - wentry <- liftIONow $ entry f [] + wentry <- liftIO $ entry f [] bentry <- trimB =<< behaviorText wentry "" return (wentry, bentry) diff --git a/src/CRUD.hs b/src/CRUD.hs --- a/src/CRUD.hs +++ b/src/CRUD.hs @@ -178,7 +178,7 @@ (Tidings t (Maybe a)) -- current selection as item (possibly empty) reactiveListDisplay w bitems bsel bdisplay = do -- animate output items - liftIONow $ putStrLn "test" + liftIO $ putStrLn "test" sink w [ items :== map <$> bdisplay <*> bitems ] -- animate output selection diff --git a/src/Reactive/Banana/WX.hs b/src/Reactive/Banana/WX.hs --- a/src/Reactive/Banana/WX.hs +++ b/src/Reactive/Banana/WX.hs @@ -36,7 +36,7 @@ event1 :: Frameworks t => w -> WX.Event w (a -> IO ()) -> Moment t (Event t a) event1 widget e = do - addHandler <- liftIONow $ event1ToAddHandler widget e + addHandler <- liftIO $ event1ToAddHandler widget e fromAddHandler addHandler -- NOTE: Some events don't work, for instance leftKey and rightKey @@ -79,7 +79,7 @@ eventText :: Frameworks t => TextCtrl w -> Moment t (Event t String) eventText w = do - addHandler <- liftIONow $ event1ToAddHandler w (event0ToEvent1 onText) + addHandler <- liftIO $ event1ToAddHandler w (event0ToEvent1 onText) fromAddHandler $ filterAddHandler (const $ WXCore.textCtrlIsModified w) $ mapIO (const $ get w text) addHandler @@ -102,8 +102,8 @@ eventSelection :: Frameworks t => SingleListBox b -> Moment t (Event t Int) eventSelection w = do - liftIONow $ fixSelectionEvent w - addHandler <- liftIONow $ event1ToAddHandler w (event0ToEvent1 select) + liftIO $ fixSelectionEvent w + addHandler <- liftIO $ event1ToAddHandler w (event0ToEvent1 select) fromAddHandler $ mapIO (const $ get w selection) addHandler -- Fix @select@ event not being fired when items are *un*selected. diff --git a/src/Tidings.hs b/src/Tidings.hs new file mode 100644 --- /dev/null +++ b/src/Tidings.hs @@ -0,0 +1,40 @@ +{----------------------------------------------------------------------------- + reactive-banana +------------------------------------------------------------------------------} +module Tidings ( + -- * Synopsis + -- The 'Tidings' data type for composing user events. + -- + -- See + -- 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 diff --git a/src/Wave.hs b/src/Wave.hs --- a/src/Wave.hs +++ b/src/Wave.hs @@ -93,7 +93,7 @@ scheduleQueue :: Frameworks t => Timer -> Event t (Enqueue a) -> Moment t (Event t a) scheduleQueue t e = do - liftIONow $ set t [ enabled := False ] + liftIO $ set t [ enabled := False ] eAlarm <- event0 t command let -- (Queue that keeps track of events to schedule