reactive-banana-wx 0.7.1.0 → 0.8.0.0

raw patch · 16 files changed

+97/−63 lines, 16 filesdep ~containersdep ~reactive-bananasetup-changed

Dependency ranges changed: containers, reactive-banana

Files

CHANGELOG.md +6/−0
Makefile +13/−19
Setup.hs +16/−4
reactive-banana-wx.cabal +6/−5
src/Animation.hs +0/−1
src/Arithmetic.hs +2/−1
src/BarTab.hs +6/−2
src/CRUD.hs +20/−12
src/Counter.hs +1/−2
src/CurrencyConverter.hs +1/−2
src/NetMonitor.hs +1/−0
src/Paths.hs +1/−0
src/Reactive/Banana/WX.hs +7/−7
src/TicTacToe.hs +5/−3
src/TwoCounters.hs +1/−2
src/Wave.hs +11/−3

+ CHANGELOG.md view

@@ -0,0 +1,6 @@+Changelog for the `reactive-banana-wx` package+----------------------------------------------++**version 0.8.0.0**++* The library now depends on `reactive-banana` version `== 0.8.*`.

Makefile view

@@ -1,50 +1,44 @@ .PHONY: all test  APPS=Asteroids Counter CRUD CurrencyConverter NetMonitor TicTacToe TwoCounters Wave-OBJ=dist/build-COMPILE= \-	ghc --make -i$(OBJ) -L/usr/lib -L$(OBJ) \-	-isrc -i../reactive-banana/src -idist/build/autogen \-	-DbuildExamples+BUILD = cabal build --ghc-options=-L/usr/lib  # Compile all programs with cabal all:-	cabal configure -fbuildExamples && cabal build --ghc-options=-L/usr/lib+	cabal configure -fbuildExamples && $(BUILD)   # Compile individual programs for testing Animation : src/Animation.hs src/Reactive/Banana/WX.hs-	$(COMPILE) -o $@ $< -outputdir $(OBJ)/$@.tmp/ && macosx-app $@ \-	    && cp data/* $@.app/Contents/Resources+	$(BUILD) $@  Arithmetic : src/Arithmetic.hs src/Reactive/Banana/WX.hs-	$(COMPILE) -o $@ $< -outputdir $(OBJ)/$@.tmp/ && macosx-app $@+	$(BUILD) $@  Asteroids : src/Asteroids.hs src/Reactive/Banana/WX.hs-	$(COMPILE) -o $@ $< -outputdir $(OBJ)/$@.tmp/ && macosx-app $@ \-	    && cp data/* $@.app/Contents/Resources+	$(BUILD) $@  BarTab : src/BarTab.hs src/Reactive/Banana/WX.hs-	$(COMPILE) -o $@ $< -outputdir $(OBJ)/$@.tmp/ && macosx-app $@+	$(BUILD) $@  Counter : src/Counter.hs src/Reactive/Banana/WX.hs-	$(COMPILE) -o $@ $< -outputdir $(OBJ)/$@.tmp/ && macosx-app $@+	$(BUILD) $@  CRUD : src/CRUD.hs src/Reactive/Banana/WX.hs-	$(COMPILE) -o $@ $< -outputdir $(OBJ)/$@.tmp/ && macosx-app $@+	$(BUILD) $@  CurrencyConverter : src/CurrencyConverter.hs src/Reactive/Banana/WX.hs-	$(COMPILE) -o $@ $< -outputdir $(OBJ)/$@.tmp/ && macosx-app $@+	$(BUILD) $@  NetMonitor : src/NetMonitor.hs src/Reactive/Banana/WX.hs-	$(COMPILE) -o $@ $< -outputdir $(OBJ)/$@.tmp/ && macosx-app $@+	$(BUILD) $@  TicTacToe : src/TicTacToe.hs src/Reactive/Banana/WX.hs-	$(COMPILE) -o $@ $< -outputdir $(OBJ)/$@.tmp/ && macosx-app $@+	$(BUILD) $@  TwoCounters : src/TwoCounters.hs src/Reactive/Banana/WX.hs-	$(COMPILE) -o $@ $< -outputdir $(OBJ)/$@.tmp/ && macosx-app $@+	$(BUILD) $@  Wave : src/Wave.hs src/Reactive/Banana/WX.hs-	$(COMPILE) -o $@ $< -outputdir $(OBJ)/$@.tmp/ && macosx-app $@+	$(BUILD) $@

Setup.hs view

@@ -2,13 +2,25 @@ -- Modeled after the excellent documentation on  -- https://github.com/gimbo/cabal-macosx/tree/master/examples -import Distribution.MacOSX+import Distribution.MacOSX as Mac import Distribution.Simple+import Distribution.Simple.LocalBuildInfo  main :: IO ()-main = defaultMainWithHooks $ simpleUserHooks {-         postBuild = appBundleBuildHook guiApps -- no-op if not MacOS X-       }+main = defaultMainWithHooks $ simpleUserHooks+    { postBuild = myPostBuild -- no-op if not MacOS X+    }++myPostBuild a b c d = Mac.appBundleBuildHook (filterApps a guiApps) a b c d++filterApps :: [String] -> [MacApp] -> [MacApp]+filterApps args apps = if null names then apps else names+    where+    names = [ app+        | app@(MacApp name1 _ _ _ _ _) <- apps+        , name2 <- args+        , name1 == name2+        ]  guiApps :: [MacApp] guiApps =

reactive-banana-wx.cabal view

@@ -1,5 +1,5 @@ Name:                reactive-banana-wx-Version:             0.7.1.0+Version:             0.8.0.0 Synopsis:            Examples for the reactive-banana library, using wxHaskell. Description:     This library provides some GUI examples for the @reactive-banana@ library,@@ -21,11 +21,12 @@ Author:              Heinrich Apfelmus Maintainer:          Heinrich Apfelmus <apfelmus quantentunnel de> Category:            FRP, GUI-Cabal-version:       >=1.8+Cabal-version:       >= 1.8   Build-type:          Custom-Extra-source-files:  Makefile+Extra-source-files:  CHANGELOG.md,+                     Makefile  data-dir:            data data-files:          *.ico, *.wav, *.png@@ -38,7 +39,7 @@     hs-source-dirs:  src     build-depends:   base >= 4.2 && < 5,                      cabal-macosx >= 0.1 && < 0.3,-                     reactive-banana >= 0.7.1.0 && < 0.8,+                     reactive-banana == 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@@ -112,7 +113,7 @@  Executable CRUD     if flag(buildExamples)-        build-depends: containers >= 0.3 && < 0.5,+        build-depends: containers >= 0.3 && < 0.6,                        reactive-banana, wx, wxcore, base     else         buildable: False

src/Animation.hs view

@@ -8,7 +8,6 @@ import Graphics.UI.WX hiding (Event, Vector) import Reactive.Banana import Reactive.Banana.WX-import System.Random  import Paths (getDataFile)

src/Arithmetic.hs view

@@ -14,13 +14,14 @@ {-----------------------------------------------------------------------------     Main ------------------------------------------------------------------------------}+main :: IO () main = start $ do     f         <- frame [text := "Arithmetic"]     input1    <- entry f []     input2    <- entry f []     output    <- staticText f []     -    set f [layout := margin 10 $ row 10 $+    set f [layout := margin 10 $ row 10             [widget input1, label "+", widget input2             , label "=", minsize (sz 40 20) $ widget output]]

src/BarTab.hs view

@@ -17,6 +17,7 @@ {-----------------------------------------------------------------------------     Main ------------------------------------------------------------------------------}+main :: IO () main = start $ do     f      <- frame [text := "Bar Tab"]     msg    <- staticText f [ text := "Sum:" ]@@ -37,7 +38,7 @@                     bentry <- trimB =<< behaviorText wentry ""                     return (wentry, bentry)             -            eNewEntry <- execute $ (FrameworksMoment newEntry <$ eAdd)+            eNewEntry <- execute $ FrameworksMoment newEntry <$ eAdd                          let                 eDoRemove = whenE (not . null <$> bEntries) eRemove@@ -60,7 +61,7 @@                                  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]]+                    ++ [row 10 [widget msg, minsize (sz 40 20) $ widget total]]                          bTotal :: Behavior t Number                 bTotal = switchB (pure Nothing) $@@ -85,5 +86,8 @@     signum = fmap signum     fromInteger = pure . fromInteger +readNumber :: Read a => String -> Maybe a readNumber s = listToMaybe [x | (x,"") <- reads s]    ++showNumber :: Maybe Double -> String showNumber   = maybe "--" show

src/CRUD.hs view

@@ -13,13 +13,9 @@ import Prelude hiding (lookup) import Data.List (isPrefixOf) import Data.Maybe-import Data.Monoid import qualified Data.Map as Map-import qualified Data.Set as Set -import qualified Graphics.UI.WX as WX import Graphics.UI.WX hiding (Event)-import qualified Graphics.UI.WXCore as WXCore import Reactive.Banana import Reactive.Banana.WX @@ -28,6 +24,7 @@ {-----------------------------------------------------------------------------     Main ------------------------------------------------------------------------------}+main :: IO () main = start $ do     -- GUI layout     f           <- frame    [ text := "CRUD Example (Simple)" ]@@ -104,7 +101,7 @@             -- automatically enable / disable editing             let                 bDisplayItem :: Behavior t Bool-                bDisplayItem = maybe False (const True) <$> bSelection+                bDisplayItem = isJust <$> bSelection                          sink deleteBtn [ enabled :== bDisplayItem ]             sink firstname [ enabled :== bDisplayItem ]@@ -119,18 +116,30 @@ type DatabaseKey = Int data Database a  = Database { nextKey :: !Int, db :: Map.Map DatabaseKey a } +emptydb :: Database a emptydb = Database 0 Map.empty++keys :: Database a -> [DatabaseKey] keys    = Map.keys . db +create :: a -> Database a -> Database a create x     (Database newkey db) = Database (newkey+1) $ Map.insert newkey x db++update :: DatabaseKey -> a -> Database a -> Database a update key x (Database newkey db) = Database newkey     $ Map.insert key    x db++delete :: DatabaseKey -> Database a -> Database a delete key   (Database newkey db) = Database newkey     $ Map.delete key db++lookup :: DatabaseKey -> Database a -> Maybe a lookup key   (Database _      db) = Map.lookup key db  {-----------------------------------------------------------------------------     Data items that are stored in the data base ------------------------------------------------------------------------------} type DataItem = (String, String)++showDataItem :: ([Char], [Char]) -> [Char] showDataItem (firstname, lastname) = lastname ++ ", " ++ firstname  -- single text entry@@ -142,10 +151,10 @@     eUser <- eventText w        -- user changes      -- filter text setting that are simultaneous with user events-    itext <- initial btext     etext <- changes btext-    let etext2 = fst $ split $ unionWith (curry snd) (Left <$> etext) (Right <$> eUser)-        btext2 = stepper itext etext2+    let+        etext2 = fst $ split $ unionWith (curry snd) (Left () <$ etext) (Right () <$ eUser)+        btext2 = imposeChanges btext etext2      sink w [ text :== btext2 ]  -- display value     return $ tidings btext eUser@@ -156,8 +165,8 @@     -> Behavior t (Maybe 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)+    t1 <- reactiveTextEntry firstname (fst . fromMaybe ("","") <$> binput)+    t2 <- reactiveTextEntry lastname  (snd . fromMaybe ("","") <$> binput)     return $ (,) <$> t1 <*> t2  @@ -178,13 +187,12 @@         (Tidings t (Maybe a))   -- current selection as item (possibly empty) reactiveListDisplay w bitems bsel bdisplay = do     -- animate output items-    liftIO $ 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-        bindex   = (\m a -> maybe (-1) id $ flip Map.lookup m =<< a) <$>+        bindex   = (\m a -> fromMaybe (-1) $ flip Map.lookup m =<< a) <$>                     bindices <*> bsel     sink w [ selection :== bindex ]

src/Counter.hs view

@@ -5,8 +5,6 @@ ------------------------------------------------------------------------------} {-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t" -import Control.Monad- import Graphics.UI.WX hiding (Event) import Reactive.Banana import Reactive.Banana.WX@@ -14,6 +12,7 @@ {-----------------------------------------------------------------------------     Main ------------------------------------------------------------------------------}+main :: IO () main = start $ do     f       <- frame [text := "Counter"]     bup     <- button f [text := "Up"]

src/CurrencyConverter.hs view

@@ -4,9 +4,7 @@     Example: Currency Converter ------------------------------------------------------------------------------} {-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t"-{-# LANGUAGE RecursiveDo #-} -import Data.Bits import Data.Maybe import Text.Printf @@ -17,6 +15,7 @@ {-----------------------------------------------------------------------------     Main ------------------------------------------------------------------------------}+main :: IO () main = start $ do     -- FIXME: Why does tab traversal not work?     f        <- frame   [ text := "Currency Converter", tabTraversal := True ]

src/NetMonitor.hs view

@@ -18,6 +18,7 @@ {-----------------------------------------------------------------------------     Main ------------------------------------------------------------------------------}+main :: IO () main = start $ do     f        <- frame    [text := "Network Monitor"]     out1     <- staticText f []

src/Paths.hs view

@@ -23,4 +23,5 @@  #endif +getDataFile :: FilePath -> FilePath getDataFile x = unsafePerformIO $ fmap (</> x) getDataDir

src/Reactive/Banana/WX.hs view

@@ -18,14 +18,13 @@      -- * Utilities     event1ToAddHandler, event0ToEvent1,-    mapIO, filterAddHandler,     ) 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.WX     as WX+import           Graphics.UI.WX               hiding (Event, Attr) import qualified Graphics.UI.WXCore as WXCore -- import Graphics.UI.WX (on, Prop(..)) @@ -63,13 +62,13 @@ -- | "Animate" a property with a behavior sink :: Frameworks t =>     w -> [Prop' t w] -> Moment t ()-sink widget props = mapM_ sink1 props+sink widget = mapM_ sink1     where     sink1 (attr :== b) = do         x <- initial b         liftIOLater $ set widget [attr := x]         e <- changes b-        reactimate $ (\x -> set widget [attr := x]) <$> e+        reactimate' $ (fmap $ \x -> set widget [attr := x]) <$> e  {-----------------------------------------------------------------------------     Specific widgets@@ -81,7 +80,7 @@ eventText w = do     addHandler <- liftIO $ event1ToAddHandler w (event0ToEvent1 onText)     fromAddHandler-        $ filterAddHandler (const $ WXCore.textCtrlIsModified w)+        $ filterIO (const $ WXCore.textCtrlIsModified w)         $ mapIO (const $ get w text) addHandler  onText :: WX.Event (WXCore.Control a) (IO ())@@ -107,13 +106,14 @@     fromAddHandler $ mapIO (const $ get w selection) addHandler  -- Fix @select@ event not being fired when items are *un*selected.+fixSelectionEvent :: (Selecting w, Reactive w, Selection w) => w -> IO () fixSelectionEvent listbox =     set listbox [ on unclick := handler ]     where     handler _ = do         propagateEvent         s <- get listbox selection-        when (s == -1) $ (get listbox (on select)) >>= id+        when (s == -1) $ get listbox (on select) >>= id   {-----------------------------------------------------------------------------

src/TicTacToe.hs view

@@ -9,7 +9,6 @@ import Control.Monad
 import Data.Array
 import Data.List hiding (union)
-import Data.Maybe
 
 import Graphics.UI.WX hiding (Event)
 import Graphics.UI.WXCore hiding (Event)
@@ -21,6 +20,7 @@     User Interface
 ------------------------------------------------------------------------------}
 
+main :: IO () main = start $ do
     -- create the main window
     window <- frame [text := "OX"]
@@ -47,8 +47,11 @@                 moves = foldl1 union $ zipWith (\e s -> move s <$ e) events
                         [(x,y) | y <- [1..3], x <- [1..3]]
             
+                eState :: Event t Game
+                eState = accumE newGame moves
+            
                 state :: Behavior t Game
-                state = accumB newGame moves
+                state = stepper newGame eState
             
                 currentPlayer :: Behavior t String
                 currentPlayer = (show . player) <$> state
@@ -66,7 +69,6 @@             sink label [text :== ("Move: " ++) <$> currentPlayer]
             
             -- end game event handler
-            eState <- changes state
             reactimate $ end window <$> filterJust (isGameEnd . board <$> eState)
     
     network <- compile networkDescription

src/TwoCounters.hs view

@@ -5,8 +5,6 @@ ------------------------------------------------------------------------------} {-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t" -import Control.Monad- import Graphics.UI.WX hiding (Event) import Reactive.Banana import Reactive.Banana.WX@@ -14,6 +12,7 @@ {-----------------------------------------------------------------------------     Main ------------------------------------------------------------------------------}+main :: IO () main = start $ do     f       <- frame [text := "Two Counters"]     bup     <- button f [text := "Up"]

src/Wave.hs view

@@ -9,7 +9,6 @@  import Control.Monad import qualified Data.List as List-import Data.Maybe import Data.Ord  import Graphics.UI.WX hiding (Event)@@ -19,16 +18,22 @@ {-----------------------------------------------------------------------------     Main ------------------------------------------------------------------------------}+lightCount :: Int lightCount = 15  -- number of lights that comprise the wave++waveLength :: Int waveLength = 4   -- number of lights that are lit at once++dt :: Int dt         = 70  -- half the cycle duration +main :: IO () main = start $ do     -- create window and widgets     f        <- frame    [text := "Waves of Light"]     left     <- button f [text := "Left"]     right    <- button f [text := "Right"]-    lights   <- sequence $ replicate lightCount $ staticText f [text := "•"]+    lights   <- replicateM lightCount $ staticText f [text := "•"]          set f [layout := margin 10 $             column 10 [row 5 [widget left, widget right],@@ -77,7 +82,10 @@     ons  = [(k*2*dt, (f k, True)) | k <- [1..lightCount]]     offs = [(dt+(waveLength+k)*2*dt, (f k, False)) | k <- [1..lightCount]] +waveLeft :: [(Duration, Action)] waveLeft  = wave id++waveRight :: [(Duration, Action)] waveRight = wave (\k -> lightCount - k + 1)  @@ -115,7 +123,7 @@         -- The queue is never empty when the alarm rings.         eout = fmap (snd . head) $ bQueue <@ eAlarm     -    reactimate $ eSetNewAlarmDuration+    reactimate eSetNewAlarmDuration     return eout