diff --git a/reactive-banana/CHANGELOG.md b/reactive-banana/CHANGELOG.md index 1b6445fb..af704e8d 100644 --- a/reactive-banana/CHANGELOG.md +++ b/reactive-banana/CHANGELOG.md @@ -1,6 +1,10 @@ Changelog for the `reactive-banana` package ------------------------------------------- +**Unreleased** + +* Added `activate` as an alias to `actuate`. `actuate` is now deprecated, albeit not with a DEPRECATED pragma (yet). + **Version 1.3.2.0** (2023-01-22) * Fixed multiple space leaks for dynamic event switching by completely redesigning low-level internals. Added automated tests on garbage collection and space leaks in order to make sure that the leaks stay fixed. [#261][], [#267][], [#268][] diff --git a/reactive-banana/benchmark/Main.hs b/reactive-banana/benchmark/Main.hs index 590cb1af..c86b6d78 100644 --- a/reactive-banana/benchmark/Main.hs +++ b/reactive-banana/benchmark/Main.hs @@ -5,7 +5,7 @@ module Main ( main ) where import Control.Monad (replicateM, replicateM_, forM_) import qualified Data.IntMap.Strict as IM import Reactive.Banana.Combinators ( Event, Behavior, MonadMoment, filterE, accumE, switchB, accumB ) -import Reactive.Banana.Frameworks (MomentIO, newAddHandler, fromAddHandler, compile, actuate, Handler, reactimate) +import Reactive.Banana.Frameworks (MomentIO, newAddHandler, fromAddHandler, compile, activate, Handler, reactimate) import Reactive.Banana ( Event, Behavior, MonadMoment ) import System.Random (randomRIO) import Test.Tasty (withResource) @@ -40,7 +40,7 @@ main = defaultMain $ [ mkBenchmarkGroup netsize | netsize <- [ 1, 2, 4, 8, 16, 3 network <- compile $ do e <- fromAddHandler tick reactimate $ return <$> e - actuate network + activate network return onTick setupBenchmark :: Int -> IO ([Handler ()], Handler Int) @@ -74,7 +74,7 @@ setupBenchmark netsize = do count :: MonadMoment m => Event () -> m (Behavior Int) count e = accumB 0 ((+1) <$ e) - actuate =<< compile networkD + activate =<< compile networkD return (triggers, trigger) where keepTail :: [a] -> [a] diff --git a/reactive-banana/doc/examples/ActuatePause.hs b/reactive-banana/doc/examples/ActuatePause.hs index f415c9f5..9bc49300 100644 --- a/reactive-banana/doc/examples/ActuatePause.hs +++ b/reactive-banana/doc/examples/ActuatePause.hs @@ -1,7 +1,7 @@ {----------------------------------------------------------------------------- reactive-banana - Example: Actuate and pause an event network + Example: Activate and pause an event network ------------------------------------------------------------------------------} import Control.Monad (when) import Data.Maybe (isJust, fromJust) @@ -20,16 +20,16 @@ main = do displayHelpMessage sources <- (,) <$> newAddHandler <*> newAddHandler network <- setupNetwork sources - actuate network + activate network eventLoop sources network displayHelpMessage :: IO () displayHelpMessage = mapM_ putStrLn $ "Commands are:": - " count - send counter event": - " pause - pause event network": - " actuate - actuate event network": - " quit - quit the program": + " count - send counter event": + " pause - pause event network": + " activate - activate event network": + " quit - quit the program": "": [] @@ -42,11 +42,11 @@ eventLoop (escounter, espause) network = loop hFlush stdout s <- getLine case s of - "count" -> fire escounter () - "pause" -> fire espause network - "actuate" -> actuate network - "quit" -> return () - _ -> putStrLn $ s ++ " - unknown command" + "count" -> fire escounter () + "pause" -> fire espause network + "activate" -> activate network + "quit" -> return () + _ -> putStrLn $ s ++ " - unknown command" when (s /= "quit") loop {----------------------------------------------------------------------------- diff --git a/reactive-banana/doc/examples/Counter.hs b/reactive-banana/doc/examples/Counter.hs index b64b46d6..198137bf 100644 --- a/reactive-banana/doc/examples/Counter.hs +++ b/reactive-banana/doc/examples/Counter.hs @@ -1,7 +1,7 @@ {----------------------------------------------------------------------------- reactive-banana - Example: Actuate and pause an event network acting as a counter + Example: Activate and pause an event network acting as a counter ------------------------------------------------------------------------------} import Control.Monad (when) import System.IO @@ -15,7 +15,7 @@ main = do displayHelpMessage sources <- (,,) <$> newAddHandler <*> newAddHandler <*> newAddHandler network <- setupNetwork sources - actuate network + activate network eventLoop sources network displayHelpMessage :: IO () @@ -24,7 +24,7 @@ displayHelpMessage = mapM_ putStrLn $ " + - increase counterUp event": " - - decrease counterUp event": " p - pause event network": - " a - actuate event network": + " a - activate event network": " q - quit the program": "": [] @@ -42,7 +42,7 @@ eventLoop (eplus, eminus, espause) network = loop '+' -> fire eplus () '-' -> fire eminus () 'p' -> fire espause network - 'a' -> actuate network + 'a' -> activate network 'q' -> return () _ -> putStrLn $ [s] ++ " - unknown command" when (s /= 'q') loop diff --git a/reactive-banana/doc/examples/Octave.hs b/reactive-banana/doc/examples/Octave.hs index 5150c780..848e55eb 100644 --- a/reactive-banana/doc/examples/Octave.hs +++ b/reactive-banana/doc/examples/Octave.hs @@ -82,7 +82,7 @@ main :: IO () main = do (addKeyEvent, fireKey) <- newAddHandler network <- compile (makeNetworkDescription addKeyEvent) - actuate network + activate network hSetEcho stdin False hSetBuffering stdin NoBuffering forever (getChar >>= fireKey) diff --git a/reactive-banana/doc/examples/SlotMachine.hs b/reactive-banana/doc/examples/SlotMachine.hs index ee3fa916..f31ee963 100644 --- a/reactive-banana/doc/examples/SlotMachine.hs +++ b/reactive-banana/doc/examples/SlotMachine.hs @@ -29,7 +29,7 @@ main = do displayHelpMessage sources <- makeSources network <- compile $ networkDescription sources - actuate network + activate network eventLoop sources displayHelpMessage :: IO () diff --git a/reactive-banana/doc/hal7/Animation.hs b/reactive-banana/doc/hal7/Animation.hs index feccdc80..aad76a19 100644 --- a/reactive-banana/doc/hal7/Animation.hs +++ b/reactive-banana/doc/hal7/Animation.hs @@ -82,9 +82,9 @@ main = start $ do -- animate the sprite sink pp [on paint :== drawSprite . toPoint <$> bposition] reactimate $ repaint pp <$ etick - - network <- compile networkDescription - actuate network + + network <- compile networkDescription + activate network {----------------------------------------------------------------------------- 2D Geometry diff --git a/reactive-banana/doc/hal7/Beispiel1.hs b/reactive-banana/doc/hal7/Beispiel1.hs index 4e7a6d2e..4938bcfd 100644 --- a/reactive-banana/doc/hal7/Beispiel1.hs +++ b/reactive-banana/doc/hal7/Beispiel1.hs @@ -50,6 +50,6 @@ main = start $ do sink output [text :== bresult] network <- compile networkDescription - actuate network + activate network diff --git a/reactive-banana/doc/hal7/Beispiel2.hs b/reactive-banana/doc/hal7/Beispiel2.hs index 3cadfc99..bca6fe95 100644 --- a/reactive-banana/doc/hal7/Beispiel2.hs +++ b/reactive-banana/doc/hal7/Beispiel2.hs @@ -42,6 +42,6 @@ main = start $ do sink output [text :== bresult] network <- compile networkDescription - actuate network + activate network diff --git a/reactive-banana/doc/hal7/Beispiel3.hs b/reactive-banana/doc/hal7/Beispiel3.hs index 9fe045aa..b53a682f 100644 --- a/reactive-banana/doc/hal7/Beispiel3.hs +++ b/reactive-banana/doc/hal7/Beispiel3.hs @@ -55,6 +55,6 @@ main = start $ do sink output [text :== bresult] network <- compile networkDescription - actuate network + activate network diff --git a/reactive-banana/src/Reactive/Banana/Frameworks.hs b/reactive-banana/src/Reactive/Banana/Frameworks.hs index b8f2eca0..7dbe45e7 100644 --- a/reactive-banana/src/Reactive/Banana/Frameworks.hs +++ b/reactive-banana/src/Reactive/Banana/Frameworks.hs @@ -33,7 +33,10 @@ module Reactive.Banana.Frameworks ( interpretFrameworks, newEvent, mapEventIO, newBehavior, -- * Running event networks - EventNetwork, actuate, pause, getSize, + EventNetwork, activate, pause, getSize, + + -- * Deprecated + actuate ) where @@ -72,7 +75,7 @@ describe the inputs, outputs and event graph in the 'MomentIO' monad and use the 'compile' function to obtain an event network from that. -To /activate/ an event network, use the 'actuate' function. +To /activate/ an event network, use the 'activate' function. The network will register its input event handlers and start producing output. @@ -107,7 +110,7 @@ A typical setup looks like this: > -- compile network description into a network > network <- compile networkDescription > -- register handlers and start producing outputs -> actuate network +> activate network In short, @@ -117,7 +120,7 @@ The library uses this to register event handlers with your event-based framework * Use 'reactimate' to animate /output/ events. * Use 'compile' to put everything together in an 'EventNetwork's -and use 'actuate' to start handling events. +and use 'activate' to start handling events. -} @@ -164,7 +167,7 @@ reactimate' = MIO . Prim.addReactimate . Prim.mapE unF . unE -- | Input, -- obtain an 'Event' from an 'AddHandler'. -- --- When the event network is actuated, +-- When the event network is activated, -- this will register a callback function such that -- an event will occur whenever the callback function is called. fromAddHandler ::AddHandler a -> MomentIO (Event a) @@ -300,7 +303,7 @@ liftIOLater = MIO . Prim.liftIOLater -- | Compile the description of an event network -- into an 'EventNetwork' --- that you can 'actuate', 'pause' and so on. +-- that you can 'activate', 'pause' and so on. compile :: MomentIO () -> IO EventNetwork compile = fmap EN . Prim.compile . unMIO @@ -311,11 +314,15 @@ compile = fmap EN . Prim.compile . unMIO -- It may be paused or already running. newtype EventNetwork = EN { unEN :: Prim.EventNetwork } --- | Actuate an event network. +-- | Activate an event network. -- The inputs will register their event handlers, so that -- the networks starts to produce outputs in response to input events. +activate :: EventNetwork -> IO () +activate = Prim.activate . unEN + +-- | Deprecated alias for 'activate'. actuate :: EventNetwork -> IO () -actuate = Prim.actuate . unEN +actuate = activate -- | Pause an event network. -- Immediately stop producing output. @@ -323,7 +330,7 @@ actuate = Prim.actuate . unEN -- Hence, the network stops responding to input events, -- but it's state will be preserved. -- --- You can resume the network with 'actuate'. +-- You can resume the network with 'activate'. -- -- Note: You can stop a network even while it is processing events, -- i.e. you can use 'pause' as an argument to 'reactimate'. @@ -401,7 +408,7 @@ interpretFrameworks f xs = do e2 <- f e1 reactimate $ writeIORef output . Just <$> e2 - actuate network + activate network forM xs $ \x -> do case x of Nothing -> return Nothing @@ -419,5 +426,5 @@ interpretAsHandler f addHandlerA = AddHandler $ \handlerB -> do e1 <- fromAddHandler addHandlerA e2 <- liftMoment (f e1) reactimate $ handlerB <$> e2 - actuate network + activate network return (pause network) diff --git a/reactive-banana/src/Reactive/Banana/Prim/High/Combinators.hs b/reactive-banana/src/Reactive/Banana/Prim/High/Combinators.hs index 1b9b6e39..80e6d831 100644 --- a/reactive-banana/src/Reactive/Banana/Prim/High/Combinators.hs +++ b/reactive-banana/src/Reactive/Banana/Prim/High/Combinators.hs @@ -47,13 +47,13 @@ interpret f xs = do ------------------------------------------------------------------------------} -- | Data type representing an event network. data EventNetwork = EventNetwork - { actuated :: IORef Bool + { activated :: IORef Bool , size :: IORef Int , s :: MVar Prim.Network } runStep :: EventNetwork -> Prim.Step -> IO () -runStep EventNetwork{ actuated, s, size } f = whenFlag actuated $ do +runStep EventNetwork{ activated, s, size } f = whenFlag activated $ do output <- mask $ \restore -> do s1 <- takeMVar s -- read and take lock -- pollValues <- sequence polls -- poll mutable data @@ -70,20 +70,20 @@ runStep EventNetwork{ actuated, s, size } f = whenFlag actuated $ do getSize :: EventNetwork -> IO Int getSize EventNetwork{size} = readIORef size -actuate :: EventNetwork -> IO () -actuate EventNetwork{ actuated } = writeIORef actuated True +activate :: EventNetwork -> IO () +activate EventNetwork{ activated } = writeIORef activated True pause :: EventNetwork -> IO () -pause EventNetwork{ actuated } = writeIORef actuated False +pause EventNetwork{ activated } = writeIORef activated False -- | Compile to an event network. compile :: Moment () -> IO EventNetwork compile setup = do - actuated <- newIORef False -- flag to set running status - s <- newEmptyMVar -- setup callback machinery - size <- newIORef 0 + activated <- newIORef False -- flag to set running status + s <- newEmptyMVar -- setup callback machinery + size <- newIORef 0 - let eventNetwork = EventNetwork{ actuated, s, size } + let eventNetwork = EventNetwork{ activated, s, size } (_output, s0) <- -- compile initial graph Prim.compile (runReaderT setup eventNetwork) =<< Prim.emptyNetwork diff --git a/reactive-banana/test/Reactive/Banana/Test/High/Space.hs b/reactive-banana/test/Reactive/Banana/Test/High/Space.hs index 0b76efd7..c29b287c 100644 --- a/reactive-banana/test/Reactive/Banana/Test/High/Space.hs +++ b/reactive-banana/test/Reactive/Banana/Test/High/Space.hs @@ -69,7 +69,7 @@ runNetworkSizes f xs = do eout <- f ein reactimate $ pure () <$ eout performSufficientGC - actuate network + activate network pure (network, fire) run network fire = forM xs $ \i -> do