reactive-banana 0.9.0.0 → 1.0.0.0

raw patch · 27 files changed

+786/−890 lines, 27 filesbinary-addedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +28/−3
• LICENSE +1/−1
• doc/examples/ActuatePause.hs +1/−1
• doc/examples/Bug.hs +0/−24
• doc/examples/Counter.hs +4/−1
• doc/examples/Octave.hs +19/−10
• doc/examples/SlotMachine.hs +35/−33
• doc/frp-behavior.png binary
• doc/frp-event.png binary
• doc/frp-stepper.png binary
• reactive-banana.cabal +13/−14
• src/Control/Event/Handler.hs +1/−1
• src/Reactive/Banana.hs +33/−5
• src/Reactive/Banana/Combinators.hs +190/−178
• src/Reactive/Banana/Experimental/Calm.hs +0/−130
• src/Reactive/Banana/Frameworks.hs +120/−123
• src/Reactive/Banana/Internal/Combinators.hs +39/−28
• src/Reactive/Banana/Internal/Phantom.hs +0/−21
• src/Reactive/Banana/Model.hs +109/−74
• src/Reactive/Banana/Prim/Cached.hs +1/−1
• src/Reactive/Banana/Prim/Compile.hs +1/−1
• src/Reactive/Banana/Prim/Evaluation.hs +1/−1
• src/Reactive/Banana/Prim/OrderedBag.hs +11/−3
• src/Reactive/Banana/Switch.hs +0/−112
• src/Reactive/Banana/Test.hs +96/−77
• src/Reactive/Banana/Test/Plumbing.hs +18/−19
• src/Reactive/Banana/Types.hs +65/−29

@@ -1,6 +1,30 @@ Changelog for the `reactive-banana` package ------------------------------------------- +**version 1.0.0.0**++The API has been redesigned significantly in this version!++* Remove phantom type parameter `t` from `Event`, `Behavior` and `Moment` types.+    * Change accumulation functions (`accumB`, `accumE`, `stepper`) to have a monadic result type.+    * Merge module `Reactive.Banana.Switch` into module `Reactive.Banana.Combinators`.+    * Simplify types of the switching functions (`switchE`, `switchB`, `observeB`, `execute`).+    * Remove functions `trimE` and `trimB`.+    * Remove types `AnyMoment` and `Identity`.+* Remove `Frameworks` class constraint, use `MomentIO` type instead.+    * Add class `MonadMoment` for both polymorphism over the `Moment` and `MomentIO` types.+* Change type `Event` to only allow a single event per moment in time.+    * Remove function `union`. Use `unionWith` instead.+    * Change function `unions` to only merge events of type `Event (a -> a)`.+* Remove module `Reactive.Banana.Experimental.Calm`.+* Change the model implementation in the module `Reactive.Banana.Model` to the new API as well.++Other changes:++* Add `mapEventIO` utility function to build an Event that contains the result of an IO computation.+* Add `newBehavior` utility function to build a Behavior that can be updated with a `Handler`.+* Add illustrations to the API documentation.+ **version 0.9.0.0**  * Implement garbage collection for dynamically switched events.@@ -8,7 +32,8 @@ * Limit value recursion in the `Moment` monad slightly. * Change `initial` and `valueB` to behave subtly different when it comes to value recursion in the `Moment` monad. * Add `Functor`, `Applicative` and `Monad` instances for the `FrameworksMoment` type.-* Depend on the [pqueues][] package instead of the [psqueues][] package again, as the former has been updated to work with the current version of GHC.+* Depend on the [pqueue][] package instead of the [psqueues][] package again, as the former has been updated to work with the current version of GHC.+   [#79]: https://github.com/HeinrichApfelmus/reactive-banana/issues/79  **version 0.8.1.2**@@ -30,7 +55,7 @@  **version 0.8.0.4** -* Just a reupload. The previous archive was broken.+* Just a re-upload. The previous archive was broken.  **version 0.8.0.3** @@ -81,7 +106,7 @@ * Remove general `Monoid` instance for `Event` to simplify reasoning about simultaneous events. * Add `initial` and `changes` combinators that allow you to observe updates to `Behavior`. Remove the `Reactive.Banana.Incremental` module. * Rename most modules,-* Change type singaturs: The main types `Event`, `Behavior` and `NetworkDescription` now carry an additional phantom type.+* Change type signatures: The main types `Event`, `Behavior` and `NetworkDescription` now carry an additional phantom type.  **version 0.4.3.1** 

@@ -1,4 +1,4 @@-Copyright (c)2011, Heinrich Apfelmus+Copyright (c)2011-2015, Heinrich Apfelmus  All rights reserved. 

@@ -71,7 +71,7 @@     ecounter <- fromAddHandler (addHandler escounter)     epause   <- fromAddHandler (addHandler espause  )     -    let ecount = accumE 0 ((+1) <$ ecounter)+    ecount <- accumE 0 $ (+1) <$ ecounter          reactimate $ fmap print ecount     reactimate $ fmap pause epause

@@ -1,24 +0,0 @@-{-# LANGUAGE RecursiveDo #-}-module RBBug where--import Reactive.Banana-import Reactive.Banana.Frameworks--data State = State { stateCounter :: Int }--test :: Int -> IO ()-test n = do-    compile $ network n-    return ()--network :: Frameworks t => Int -> Moment t ()-network 1 = mdo-    let state = pure (State 0) -- switchB (pure (State 0)) never-    positivityChanges <- changes isPositive-    reactimate' (fmap (fmap print) positivityChanges)-    let isPositive = fmap ((>= 0) . stateCounter) state-    return ()-network 2 = mdo-    let b = stepper (State 0) e-    e <- execute $ (\a -> FrameworksMoment $ return a) <$> (b <@ never)-    return ()

@@ -70,7 +70,10 @@     counterDown <- fromAddHandler (addHandler eminus)     epause      <- fromAddHandler (addHandler espause) -    let ecount = accumE 0 $ ((+1) <$ counterUp) `union` (subtract 1 <$ counterDown)+    ecount <- accumE 0 $ unions+        [ (+1)       <$ counterUp+        , subtract 1 <$ counterDown+        ]      reactimate $ fmap print ecount     reactimate $ fmap pause epause

@@ -1,17 +1,22 @@ {-----------------------------------------------------------------------------     reactive-banana-    +     Example: "The world's worst synthesizer"     from the unofficial tutorial.     <http://wiki.haskell.org/FRP_explanation_using_reactive-banana> ------------------------------------------------------------------------------}+{-# LANGUAGE RecursiveDo #-}+    -- allows recursive do notation+    -- mdo+    --     ...+ module Main where -import Data.Char (toUpper)+import Data.Char     (toUpper) import Control.Monad (forever)-import System.IO (BufferMode(..), hSetEcho, hSetBuffering, stdin)+import System.IO     (BufferMode(..), hSetEcho, hSetBuffering, stdin)+ import Reactive.Banana-import Reactive.Banana.Prim (addHandler) import Reactive.Banana.Frameworks  @@ -40,7 +45,7 @@     show (Note o p) = show p ++ show o  -- Filter and transform events at the same time.-filterMapJust :: (a -> Maybe b) -> Event t a -> Event t b+filterMapJust :: (a -> Maybe b) -> Event a -> Event b filterMapJust f = filterJust . fmap f  -- Change the original octave by adding a number of octaves, taking@@ -55,16 +60,20 @@     '-' -> Just (-1)     _ -> Nothing -makeNetworkDescription :: Frameworks t => AddHandler Char -> Moment t ()+makeNetworkDescription :: AddHandler Char -> MomentIO () makeNetworkDescription addKeyEvent = do     eKey <- fromAddHandler addKeyEvent++    let eOctaveChange = filterMapJust getOctaveChange eKey+    bOctave <- accumB 3 (changeOctave <$> eOctaveChange)++    let ePitch = filterMapJust (`lookup` charPitches) eKey+    bPitch <- stepper PC ePitch+     let-        eOctaveChange = filterMapJust getOctaveChange eKey-        bOctave = accumB 3 (changeOctave <$> eOctaveChange)-        ePitch = filterMapJust (`lookup` charPitches) eKey-        bPitch = stepper PC ePitch         bNote = Note <$> bOctave <*> bPitch         foo = Note 0 PA+     eNoteChanged <- changes bNote     reactimate' $ fmap (\n -> putStrLn ("Now playing " ++ show n))                  <$> eNoteChanged

@@ -3,7 +3,14 @@          Example: Slot machine ------------------------------------------------------------------------------}-{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. NetworkDescription t"+{-# LANGUAGE ScopedTypeVariables #-}+    -- allows pattern signatures like+    -- do+    --     (b :: Behavior Int) <- stepper 0 ...+{-# LANGUAGE RecursiveDo #-}+    -- allows recursive do notation+    -- mdo+    --     ...  import Control.Monad (when) import Data.Maybe (isJust, fromJust)@@ -21,7 +28,7 @@ main = do     displayHelpMessage     sources <- makeSources-    network <- compile $ setupNetwork sources+    network <- compile $ networkDescription sources     actuate network     eventLoop sources @@ -79,10 +86,9 @@ data Win = Double | Triple  --- Set up the program logic in terms of events and behaviors.-setupNetwork :: forall t. Frameworks t => -    (EventSource (), EventSource ()) -> Moment t ()-setupNetwork (escoin,esplay) = do+-- Program logic in terms of events and behaviors.+networkDescription :: (EventSource (), EventSource ()) -> MomentIO ()+networkDescription (escoin,esplay) = mdo     -- initial random number generator     initialStdGen <- liftIO $ newStdGen @@ -90,20 +96,19 @@     ecoin <- fromAddHandler (addHandler escoin)     eplay <- fromAddHandler (addHandler esplay)     -    let         -        -- The state of the slot machine is captured in Behaviors.-            -        -- State: credits that the player has to play the game-        -- The  ecoin      event adds a coin to the credits-        -- The  edoesplay  event removes money-        -- The  ewin       event adds credits because the player has won-        bcredits :: Behavior t Money-        ecredits :: Event t Money-        (ecredits, bcredits) = mapAccum 0 . fmap (\f x -> (f x,f x)) $-            ((addCredit <$ ecoin)-            `union` (removeCredit <$ edoesplay)-            `union` (addWin <$> ewin))+    -- The state of the slot machine is captured in Behaviors.         +    -- State: credits that the player has to play the game+    -- The  ecoin      event adds a coin to the credits+    -- The  edoesplay  event removes money+    -- The  ewin       event adds credits because the player has won+    (ecredits :: Event Money, bcredits :: Behavior Money)+        <- mapAccum 0 . fmap (\f x -> (f x,f x)) $ unions $+            [ addCredit    <$ ecoin+            , removeCredit <$ edoesplay+            , addWin       <$> ewin+            ]+    let         -- functions that change the accumulated state         addCredit     = (+1)         removeCredit  = subtract 1@@ -111,34 +116,34 @@         addWin Triple = (+20)                  -- Event: does the player have enough money to play the game?-        emayplay :: Event t Bool-        emayplay = apply ((\credits _ -> credits > 0) <$> bcredits) eplay+        emayplay :: Event Bool+        emayplay = (\credits _ -> credits > 0) <$> bcredits <@> eplay                  -- Event: player has enough coins and plays-        edoesplay :: Event t ()+        edoesplay :: Event ()         edoesplay = () <$ filterE id  emayplay         -- Event: event that fires when the player doesn't have enough money-        edenied   :: Event t ()+        edenied   :: Event ()         edenied   = () <$ filterE not emayplay                  -        -- State: random number generator-        bstdgen :: Behavior t StdGen-        eroll   :: Event t Reels+    -- State: random number generator+    (eroll :: Event Reels, bstdgen :: Behavior StdGen)         -- accumulate the random number generator while rolling the reels-        (eroll, bstdgen) = mapAccum initialStdGen (roll <$> edoesplay)-        +        <- mapAccum initialStdGen $ roll <$> edoesplay++    let         -- roll the reels         roll :: () -> StdGen -> (Reels, StdGen)         roll () gen0 = ((z1,z2,z3),gen3)             where-            random = randomR(1,4)+            random    = randomR(1,4)             (z1,gen1) = random gen0             (z2,gen2) = random gen1             (z3,gen3) = random gen2                  -- Event: it's a win!-        ewin :: Event t Win+        ewin :: Event Win         ewin = fmap fromJust $ filterE isJust $ fmap checkWin eroll         checkWin (z1,z2,z3)             | length (nub [z1,z2,z3]) == 1 = Just Triple@@ -157,6 +162,3 @@ showRoll (z1,z2,z3) = "You rolled  " ++ show z1 ++ show z2 ++ show z3 showWin Double = "Wow, a double!" showWin Triple = "Wowwowow! A triple! So awesome!"---

binary file changed (absent → 18670 bytes)

binary file changed (absent → 15200 bytes)

binary file changed (absent → 20782 bytes)

@@ -1,5 +1,5 @@ Name:                reactive-banana-Version:             0.9.0.0+Version:             1.0.0.0 Synopsis:            Library for functional reactive programming (FRP). Description:     Reactive-banana is a library for Functional Reactive Programming (FRP).@@ -9,14 +9,13 @@     See the project homepage <http://wiki.haskell.org/Reactive-banana>     for more detailed documentation and examples.     .-    /Stability forecast:/-    .-    No semantic bugs expected.-    .-    Significant API changes are planned for version 1.0.-    .-    The library features an efficient, push-driven implementation+    /Stability forecast./+    This is a stable library, though minor API changes are still likely.+    It features an efficient, push-driven implementation     and has seen some optimization work.+    .+    /API guide./+    Start with the "Reactive.Banana" module.  Homepage:            http://wiki.haskell.org/Reactive-banana License:             BSD3@@ -24,13 +23,14 @@ Author:              Heinrich Apfelmus Maintainer:          Heinrich Apfelmus <apfelmus quantentunnel de> Category:            FRP-Cabal-version:       >= 1.9.2+Cabal-version:       >= 1.18 Build-type:          Simple  extra-source-files:     CHANGELOG.md,                         doc/examples/*.hs,                         src/Reactive/Banana/Test.hs,                         src/Reactive/Banana/Test/Plumbing.hs+extra-doc-files:        doc/*.png  Source-repository head     type:               git@@ -42,9 +42,10 @@                  This enables the efficient push-driven implementation,                  but doesn't necessarily work with compilers other than GHC. -- Cabal checks if the package can be build with  UseExtensions = True,--- otherewise it is set to  False .+-- otherwise it is set to  False .  Library+    default-language:   Haskell98     hs-source-dirs:     src      build-depends:      base >= 4.2 && < 5,@@ -61,18 +62,15 @@                         Control.Event.Handler,                         Reactive.Banana,                         Reactive.Banana.Combinators,-                        Reactive.Banana.Experimental.Calm,                         Reactive.Banana.Frameworks,                         Reactive.Banana.Model,                         Reactive.Banana.Prim,-                        Reactive.Banana.Prim.Cached,-                        Reactive.Banana.Switch+                        Reactive.Banana.Prim.Cached          other-modules:                         Control.Monad.Trans.ReaderWriterIO,                         Control.Monad.Trans.RWSIO,                         Reactive.Banana.Internal.Combinators,-                        Reactive.Banana.Internal.Phantom,                         Reactive.Banana.Prim.Combinators,                         Reactive.Banana.Prim.Compile,                         Reactive.Banana.Prim.Dependencies,@@ -87,6 +85,7 @@                         Reactive.Banana.Types  Test-Suite tests+    default-language:   Haskell98     type:               exitcode-stdio-1.0     hs-source-dirs:     src     main-is:            Reactive/Banana/Test.hs

@@ -22,7 +22,7 @@ -- /event value/ and performs some computation. type Handler a = a -> IO () --- | A value of type @Addhandler a@ is a facility for registering+-- | The type 'AddHandler' represents a facility for registering -- event handlers. These will be called whenever the event occurs. --  -- When registering an event handler, you will also be given an action

@@ -1,16 +1,44 @@ {------------------------------------------------------------------------------    Reactive Banana--    A small library for functional reactive programming.+    reactive-banana ------------------------------------------------------------------------------}  module Reactive.Banana (+    -- * Synopsis+    -- | Reactive-banana is a library for functional reactive programming (FRP).+    -- To use it, import this module:+    --+    -- > import Reactive.Banana++    -- * Overview+    -- $intro++    -- * Exports     module Reactive.Banana.Combinators,-    module Reactive.Banana.Switch,     compile,     ) where  import Reactive.Banana.Combinators import Reactive.Banana.Frameworks import Reactive.Banana.Types-import Reactive.Banana.Switch++{-$intro++The module "Reactive.Banana.Combinators" collects the key types+and concepts of FRP. You will spend most of your time with this module.++The module "Reactive.Banana.Model" is /not/ used in practice.+It contains an easy-to-understand model re-implementation of the FRP API.+This is useful for learning FRP and for internal testing purposes.++The module "Reactive.Banana.Frameworks" allows you to connect+the FRP types and combinators to the outside world (IO).+If you are /using/ an existing binding like reactive-banana-wx,+then you probably won't need this module very often.+On the other hand, if you are /writing/ a binding to an external+library, then you will definitely need this.++The module hierarchy at "Reactive.Banana.Prim"+implements the efficient low-level FRP engine that powers the rest of the library.+This is only useful if you want to implement your own FRP library.++-}

@@ -6,21 +6,27 @@  module Reactive.Banana.Combinators (     -- * Synopsis-    -- | Combinators for building event graphs.-    -    -- * Introduction-    -- $intro1+    -- $synopsis++    -- * Core Combinators+    -- ** Event and Behavior     Event, Behavior,-    -- $intro2     interpret,-    -    -- * Core Combinators++    -- ** First-order     module Control.Applicative,     module Data.Monoid,-    never, union, unions, filterE, collect, spill, accumE,-    apply, stepper,+    never, unionWith, filterE,+    apply,     -- $classes-    ++    -- ** Moment and accumulation+    Moment, MonadMoment(..),+    accumE, stepper,++    -- ** Higher-order+    valueB, valueBLater, observeE, switchE, switchB,+     -- * Derived Combinators     -- ** Infix operators     (<@>), (<@),@@ -28,9 +34,7 @@     filterJust, filterApply, whenE, split,     -- ** Accumulation     -- $Accumulation.-    accumB, mapAccum,-    -- ** Simultaneous event occurrences-    calm, unionWith,+    unions, accumB, mapAccum,     ) where  import Control.Applicative@@ -44,195 +48,196 @@ {-----------------------------------------------------------------------------     Introduction ------------------------------------------------------------------------------}-{-$intro1+{-$synopsis -At its core, Functional Reactive Programming (FRP) is about two-data types 'Event' and 'Behavior' and the various ways to combine them.+The main types and combinators of Functional Reactive Programming (FRP). +At its core, FRP is about two data types 'Event' and 'Behavior'+and the various ways to combine them.+There is also a third type 'Moment',+which is necessary for the higher-order combinators.+ -}  -- Event -- Behavior -{-$intro2--As you can see, both types seem to have a superfluous parameter @t@.-The library uses it to rule out certain gross inefficiencies,-in particular in connection with dynamic event switching.-For basic stuff, you can completely ignore it,-except of course for the fact that it will annoy you in your type signatures.--While the type synonyms mentioned above are the way you should think about-'Behavior' and 'Event', they are a bit vague for formal manipulation.-To remedy this, the library provides a very simple but authoritative-model implementation. See "Reactive.Banana.Model" for more.---}- {-----------------------------------------------------------------------------     Interpetation ------------------------------------------------------------------------------} -- | Interpret an event processing function. -- Useful for testing.-interpret :: (forall t. Event t a -> Event t b) -> [[a]] -> IO [[b]]-interpret f xs =-    map toList <$> Prim.interpret (return . unE . f . E) (map wrap xs)-    where-    wrap [] = Nothing-    wrap xs = Just xs--toList :: Maybe [a] -> [a]-toList Nothing   = []-toList (Just xs) = xs+interpret :: (Event a -> Event b) -> [Maybe a] -> IO [Maybe b]+interpret f = Prim.interpret (return . unE . f . E)  {-----------------------------------------------------------------------------     Core combinators ------------------------------------------------------------------------------}-singleton :: a -> [a]-singleton x = [x]- -- | Event that never occurs.--- Think of it as @never = []@.-never    :: Event t a-never = E $ Prim.mapE singleton Prim.never+-- Semantically, @never = []@.+never    :: Event a+never = E Prim.never  -- | Merge two event streams of the same type.--- In case of simultaneous occurrences, the left argument comes first.--- Think of it as+-- The function argument specifies how event values are to be combined+-- in case of a simultaneous occurrence. The semantics are ----- > union ((timex,x):xs) ((timey,y):ys)--- >    | timex <= timey = (timex,x) : union xs ((timey,y):ys)--- >    | timex >  timey = (timey,y) : union ((timex,x):xs) ys-union    :: Event t a -> Event t a -> Event t a-union e1 e2 = E $ Prim.unionWith (++) (unE e1) (unE e2)---- | Merge several event streams of the same type.--- --- > unions = foldr union never-unions :: [Event t a] -> Event t a-unions = foldr union never+-- > unionWith f ((timex,x):xs) ((timey,y):ys)+-- >    | timex <  timey = (timex,x)     : unionWith f xs ((timey,y):ys)+-- >    | timex >  timey = (timey,y)     : unionWith f ((timex,x):xs) ys+-- >    | timex == timey = (timex,f x y) : unionWith f xs ys+unionWith :: (a -> a -> a) -> Event a -> Event a -> Event a+unionWith f e1 e2 = E $ Prim.unionWith f (unE e1) (unE e2)  -- | Allow all event occurrences that are 'Just' values, discard the rest. -- Variant of 'filterE'.-filterJust :: Event t (Maybe a) -> Event t a-filterJust = E . Prim.filterJust . Prim.mapE (decide . catMaybes) . unE-    where-    decide xs = if null xs then Nothing else Just xs+filterJust :: Event (Maybe a) -> Event a+filterJust = E . Prim.filterJust . unE  -- | Allow all events that fulfill the predicate, discard the rest.--- Think of it as--- +-- Semantically,+-- -- > filterE p es = [(time,a) | (time,a) <- es, p a]-filterE   :: (a -> Bool) -> Event t a -> Event t a+filterE   :: (a -> Bool) -> Event a -> Event a filterE p = filterJust . fmap (\x -> if p x then Just x else Nothing) --- | Collect simultaneous event occurences.--- The result will never contain an empty list.--- Example:------ > collect [(time1, e1), (time1, e2)] = [(time1, [e1,e2])]-collect   :: Event t a -> Event t [a]-collect e = E $ Prim.mapE singleton (unE e)---- | Emit simultaneous event occurrences.--- The first element in the list will be emitted first, and so on.------ Up to strictness, we have------ > spill . collect = id-spill :: Event t [a] -> Event t a-spill e = E $ Prim.filterJust $ Prim.mapE (nonempty . concat) (unE e)-    where-    nonempty [] = Nothing-    nonempty xs = Just xs---- | Construct a time-varying function from an initial value and --- a stream of new values. Think of it as------ > stepper x0 ex = \time -> last (x0 : [x | (timex,x) <- ex, timex < time])--- --- Note that the smaller-than-sign in the comparision @timex < time@ means --- that the value of the behavior changes \"slightly after\"--- the event occurrences. This allows for recursive definitions.--- --- Also note that in the case of simultaneous occurrences,--- only the last one is kept.-stepper :: a -> Event t a -> Behavior t a-stepper x e = B $ Prim.stepperB x $ Prim.mapE last $ unE e---- | The 'accumE' function accumulates a stream of events.--- Example:------ > accumE "x" [(time1,(++"y")),(time2,(++"z"))]--- >    = [(time1,"xy"),(time2,"xyz")]------ Note that the output events are simultaneous with the input events,--- there is no \"delay\" like in the case of 'accumB'.-accumE   :: a -> Event t (a -> a) -> Event t a-accumE acc = E . mapAccumE acc . Prim.mapE concatenate . unE-    where-    concatenate :: [a -> a] -> a -> ([a],a)-    concatenate fs acc = (tail values, last values)-        where values = scanl' (flip ($)) acc fs--    mapAccumE :: s -> Prim.Event (s -> (a,s)) -> Prim.Event a-    mapAccumE acc =-        Prim.mapE fst . Prim.accumE (undefined,acc) . Prim.mapE lift--    lift f (_,acc) = acc `seq` f acc----- strict version of scanl-scanl' :: (a -> b -> a) -> a -> [b] -> [a]-scanl' f x ys = x : case ys of-    []   -> []-    y:ys -> let z = f x y in z `seq` scanl' f z ys- -- | Apply a time-varying function to a stream of events.--- Think of it as--- +-- Semantically,+-- -- > apply bf ex = [(time, bf time x) | (time, x) <- ex] -- -- This function is generally used in its infix variant '<@>'.-apply    :: Behavior t (a -> b) -> Event t a -> Event t b-apply bf ex = E $ Prim.applyE (Prim.mapB map $ unB bf) (unE ex)+apply :: Behavior (a -> b) -> Event a -> Event b+apply bf ex = E $ Prim.applyE (unB bf) (unE ex)  {-$classes  /Further combinators that Haddock can't document properly./ -> instance Applicative (Behavior t)+> instance Applicative Behavior  'Behavior' is an applicative functor. In particular, we have the following functions. -> pure :: a -> Behavior t a+> pure :: a -> Behavior a -The constant time-varying value. Think of it as @pure x = \\time -> x@.+The constant time-varying value. Semantically, @pure x = \\time -> x@. -> (<*>) :: Behavior t (a -> b) -> Behavior t a -> Behavior t b+> (<*>) :: Behavior (a -> b) -> Behavior a -> Behavior b  Combine behaviors in applicative style.-Think of it as @bf \<*\> bx = \\time -> bf time $ bx time@.+The semantics are: @bf \<*\> bx = \\time -> bf time $ bx time@.  -} -{- No monoid instance, sorry.--instance Monoid (Event t (a -> a)) where-    mempty  = never-    mappend = unionWith (flip (.))--}--instance Functor (Event t) where-    fmap f e = E $ Prim.mapE (map f) (unE e)+instance Functor Event where+    fmap f = E . Prim.mapE f . unE -instance Applicative (Behavior t) where+instance Applicative Behavior where     pure x    = B $ Prim.pureB x     bf <*> bx = B $ Prim.applyB (unB bf) (unB bx) -instance Functor (Behavior t) where+instance Functor Behavior where     fmap = liftA +-- | Construct a time-varying function from an initial value and+-- a stream of new values. The result will be a step function.+-- Semantically,+--+-- > stepper x0 ex = \time1 -> \time2 ->+-- >     last (x0 : [x | (timex,x) <- ex, time1 <= timex, timex < time2])+--+-- Here is an illustration of the result Behavior at a particular time:+--+-- <<doc/frp-stepper.png>>+--+-- Note: The smaller-than-sign in the comparison @timex < time2@ means+-- that at time @time2 == timex@, the value of the Behavior will+-- still be the previous value.+-- In the illustration, this is indicated by the dots at the end+-- of each step.+-- This allows for recursive definitions.+stepper :: MonadMoment m => a -> Event a -> m (Behavior a)+stepper a = liftMoment . M . fmap B . Prim.stepperB a . unE++-- | The 'accumE' function accumulates a stream of event values,+-- similar to a /strict/ left scan, 'scanl''.+-- It starts with an initial value and emits a new value+-- whenever an event occurrence happens.+-- The new value is calculated by applying the function in the event+-- to the old value.+--+-- Example:+--+-- > accumE "x" [(time1,(++"y")),(time2,(++"z"))]+-- >     = trimE [(time1,"xy"),(time2,"xyz")]+-- >     where+-- >     trimE e start = [(time,x) | (time,x) <- e, start <= time]+--+--+-- Note: It makes sense to list the 'accumE' function as a primitive+-- combinator, but keep in mind that it can actually be expressed+-- in terms of 'stepper' and 'apply' by using recursion:+--+-- > accumE a e1 = mdo+-- >    let e2 = (\a f -> f a) <$> b <@> e1+-- >    b <- stepper a e2+-- >    return e2+--+accumE :: MonadMoment m => a -> Event (a -> a) -> m (Event a)+accumE acc = liftMoment . M . fmap E . Prim.accumE acc . unE++-- | Obtain the value of the 'Behavior' at a given moment in time.+-- Semantically, it corresponds to+--+-- > valueB b = \time -> b time+--+-- NOTE: The value is immediately available for pattern matching.+-- Unfortunately, this means that @valueB@ is unsuitable for use+-- with value recursion in the 'Moment' monad.+-- If you need recursion, please use 'valueBLater' instead.+valueB :: MonadMoment m => Behavior a -> m a+valueB = liftMoment . M . Prim.valueB . unB++-- | Obtain the value of the 'Behavior' at a given moment in time.+-- Semantically, it corresponds to+--+-- > valueBLater b = \time -> b time+--+-- NOTE: To allow for more recursion, the value is returned /lazily/+-- and not available for pattern matching immediately.+-- It can be used safely with most combinators like 'stepper'.+-- If that doesn't work for you, please use 'valueB' instead.+valueBLater :: MonadMoment m => Behavior a -> m a+valueBLater = liftMoment . M . Prim.initialBLater . unB+++-- | Observe a value at those moments in time where+-- event occurrences happen. Semantically,+--+-- > observeE e = [(time, m time) | (time, m) <- e]+observeE :: Event (Moment a) -> Event a+observeE = E . Prim.observeE . Prim.mapE unM . unE++-- | Dynamically switch between 'Event'.+-- Semantically,+--+-- > switchE ee = concat [trim t1 t2 e | (t1,t2,e) <- intervals ee]+-- >     where+-- >     intervals e        = [(time1, time2, x) | ((time1,x),(time2,_)) <- zip e (tail e)]+-- >     trim time1 time2 e = [x | (timex,x) <- e, time1 < timex, timex <= time2]++switchE :: Event (Event a) -> Event a+switchE = E . Prim.switchE . Prim.mapE (unE) . unE++-- | Dynamically switch between 'Behavior'.+-- Semantically,+--+-- >  switchB b0 eb = \time ->+-- >     last (b0 : [b | (time2,b) <- eb, time2 < time]) time++switchB :: Behavior a -> Event (Behavior a) -> Behavior a+switchB b = B . Prim.switchB (unB b) . Prim.mapE (unB) . unE+ {-----------------------------------------------------------------------------     Derived Combinators ------------------------------------------------------------------------------}@@ -253,31 +258,31 @@ infixl 4 <@>, <@  -- | Infix synonym for the 'apply' combinator. Similar to '<*>'.--- +-- -- > infixl 4 <@>-(<@>) :: Behavior t (a -> b) -> Event t a -> Event t b+(<@>) :: Behavior (a -> b) -> Event a -> Event b (<@>) = apply  -- | Tag all event occurrences with a time-varying value. Similar to '<*'. -- -- > infixl 4 <@-(<@)  :: Behavior t b -> Event t a -> Event t b-f <@ g = (const <$> f) <@> g +(<@)  :: Behavior b -> Event a -> Event b+f <@ g = (const <$> f) <@> g  -- | Allow all events that fulfill the time-varying predicate, discard the rest. -- Generalization of 'filterE'.-filterApply :: Behavior t (a -> Bool) -> Event t a -> Event t a+filterApply :: Behavior (a -> Bool) -> Event a -> Event a filterApply bp = fmap snd . filterE fst . apply ((\p a-> (p a,a)) <$> bp)  -- | Allow events only when the behavior is 'True'. -- Variant of 'filterApply'.-whenE :: Behavior t Bool -> Event t a -> Event t a+whenE :: Behavior Bool -> Event a -> Event a whenE bf = filterApply (const <$> bf)  -- | Split event occurrences according to a tag. -- The 'Left' values go into the left component while the 'Right' values -- go into the right component of the result.-split :: Event t (Either a b) -> (Event t a, Event t b)+split :: Event (Either a b) -> (Event a, Event b) split e = (filterJust $ fromLeft <$> e, filterJust $ fromRight <$> e)     where     fromLeft  (Left  a) = Just a@@ -285,39 +290,46 @@     fromRight (Left  a) = Nothing     fromRight (Right b) = Just b --- | Combine simultaneous event occurrences into a single occurrence.------ > unionWith f e1 e2 = fmap (foldr1 f) <$> collect (e1 `union` e2)-unionWith :: (a -> a -> a) -> Event t a -> Event t a -> Event t a-unionWith f e1 e2 = E $ Prim.unionWith g (unE e1) (unE e2)-    where g xs ys = singleton $ foldr1 f (xs ++ ys) --- | Keep only the last occurrence when simultaneous occurrences happen.-calm :: Event t a -> Event t a-calm = fmap last . collect- -- $Accumulation. -- Note: All accumulation functions are strict in the accumulated value!--- +-- -- Note: The order of arguments is @acc -> (x,acc)@ -- which is also the convention used by 'unfoldr' and 'State'. --- | The 'accumB' function is similar to a /strict/ left fold, 'foldl''.--- It starts with an initial value and combines it with incoming events.--- For example, think+-- | Merge event streams whose values are functions.+-- In case of simultaneous occurrences, the functions at the beginning+-- of the list are applied /after/ the functions at the end. --+-- > unions [] = never+-- > unions xs = foldr1 (unionWith (.)) xs+--+-- Very useful in conjunction with accumulation functions like 'accumB'+-- and 'accumE'.+unions :: [Event (a -> a)] -> Event (a -> a)+unions [] = never+unions xs = foldr1 (unionWith (.)) xs++-- | The 'accumB' function accumulates event occurrences into a 'Behavior'.+--+-- The value is accumulated using 'accumE' and converted+-- into a time-varying value using 'stepper'.+--+-- Example:+-- -- > accumB "x" [(time1,(++"y")),(time2,(++"z"))] -- >    = stepper "x" [(time1,"xy"),(time2,"xyz")]--- --- Note that the value of the behavior changes \"slightly after\"+--+-- Note: As with 'stepper', the value of the behavior changes \"slightly after\" -- the events occur. This allows for recursive definitions.-accumB   :: a -> Event t (a -> a) -> Behavior t a--- accumB x (Event e) = behavior $ AccumB x e-accumB  acc = stepper acc . accumE acc+accumB :: MonadMoment m => a -> Event (a -> a) -> m (Behavior a)+accumB acc e = stepper acc =<< accumE acc e  -- | Efficient combination of 'accumE' and 'accumB'.-mapAccum :: acc -> Event t (acc -> (x,acc)) -> (Event t x, Behavior t acc)-mapAccum acc ef = (fst <$> e, stepper acc (snd <$> e))+mapAccum :: MonadMoment m => acc -> Event (acc -> (x,acc)) -> m (Event x, Behavior acc)+mapAccum acc ef = do+        e <- accumE  (undefined,acc) (lift <$> ef)+        b <- stepper acc (snd <$> e)+        return (fst <$> e, b)     where-    e = accumE (undefined,acc) (lift <$> ef)     lift f (_,acc) = acc `seq` f acc

@@ -1,130 +0,0 @@-{------------------------------------------------------------------------------    Reactive Banana-------------------------------------------------------------------------------}-{-# LANGUAGE Rank2Types, MultiParamTypeClasses,-    TypeSynonymInstances, FlexibleInstances #-}--module Reactive.Banana.Experimental.Calm (-    -- * Synopsis-    -- | Experimental module: API change very likely.-    ---    -- 'Event' type that disallows simultaneous event occurrences.-    ---    -- The combinators behave essentially as their counterparts-    -- in "Reactive.Banana.Combinators".-    -    -- * Main types-    Event, Behavior, collect, fromCalm,-    interpret,-    -    -- * Core Combinators-    module Control.Applicative,-    never, unionWith, filterE, accumE,-    apply, stepper,-    -    -- * Derived Combinators-    -- ** Filtering-    filterJust,-    -- ** Accumulation-    -- $Accumulation.-    accumB, mapAccum,-    -- ** Apply class-    (<@>), (<@),-    ) where--import Control.Applicative-import Control.Monad--import Data.Maybe (listToMaybe)--import qualified Reactive.Banana.Combinators as Prim-import qualified Reactive.Banana.Combinators--{------------------------------------------------------------------------------    Main types-------------------------------------------------------------------------------}-newtype Event t a = E { unE :: Prim.Event t a }--type Behavior t = Reactive.Banana.Combinators.Behavior t---- | Convert event with possible simultaneous occurrences--- into an 'Event' with a single occurrence.-collect :: Reactive.Banana.Combinators.Event t a -> Event t [a]-collect = E . Prim.collect---- | Convert event with single occurrences into--- event with possible simultaneous occurrences-fromCalm :: Event t a -> Reactive.Banana.Combinators.Event t a-fromCalm = unE--singleton x = [x]---- | Interpretation function.--- Useful for testing.-interpret :: (forall t. Event t a -> Event t b) -> [a] -> IO [Maybe b]-interpret f xs =-    map listToMaybe <$> Prim.interpret (unE . f . E) (map singleton xs)--{------------------------------------------------------------------------------    Core Combinators-------------------------------------------------------------------------------}--- | Event that never occurs.--- Think of it as @never = []@.-never    :: Event t a-never = E $ Prim.never---- | Merge two event streams of the same type.--- Combine simultaneous values if necessary.-unionWith    :: (a -> a -> a) -> Event t a -> Event t a -> Event t a-unionWith f e1 e2 = E $ Prim.unionWith f (unE e1) (unE e2)---- | Allow all events that fulfill the predicate, discard the rest.-filterE   :: (a -> Bool) -> Event t a -> Event t a-filterE p = E . Prim.filterE p . unE---- | Construct a time-varying function from an initial value and --- a stream of new values.-stepper :: a -> Event t a -> Behavior t a-stepper x e = Prim.stepper x (unE e)---- | The 'accumE' function accumulates a stream of events.-accumE   :: a -> Event t (a -> a) -> Event t a-accumE acc = E . Prim.accumE acc . unE---- | Apply a time-varying function to a stream of events.-apply    :: Behavior t (a -> b) -> Event t a -> Event t b-apply b = E . Prim.apply b . unE--instance Functor (Event t) where-    fmap f = E . fmap f . unE--{------------------------------------------------------------------------------    Derived Combinators-------------------------------------------------------------------------------}--- | Keep only the 'Just' values.--- Variant of 'filterE'.-filterJust :: Event t (Maybe a) -> Event t a-filterJust = E . Prim.filterJust . unE---- | The 'accumB' function is similar to a /strict/ left fold, 'foldl''.--- It starts with an initial value and combines it with incoming events.-accumB :: a -> Event t (a -> a) -> Behavior t a-accumB acc = Prim.accumB acc . unE---- $Accumulation.--- Note: all accumulation functions are strict in the accumulated value!--- acc -> (x,acc) is the order used by 'unfoldr' and 'State'.---- | Efficient combination of 'accumE' and 'accumB'.-mapAccum :: acc -> Event t (acc -> (x,acc)) -> (Event t x, Behavior t acc)-mapAccum acc ef = let (e,b) = Prim.mapAccum acc (unE ef) in (E e, b)---- | Infix synonym for the 'apply' combinator. Similar to '<*>'.-(<@>) :: Behavior t (a -> b) -> Event t a -> Event t b-(<@>) = apply---- | Tag all event occurrences with a time-varying value. Similar to '<*'.-(<@)  :: Behavior t a -> Event t b -> Event t a-f <@ g = (const <$> f) <@> g --

@@ -5,32 +5,36 @@  module Reactive.Banana.Frameworks (     -- * Synopsis-    -- | Build event networks using existing event-based frameworks-    -- and run them.-    +    -- | Connect to the outside world by building 'EventNetwork's+    -- and running them.+     -- * Simple use     interpretAsHandler, -    -- * Building event networks with input/output+    -- * Overview     -- $build-    compile, Frameworks,++    -- * Building event networks with input/output+    -- ** Core functions+    compile, MomentIO,     module Control.Event.Handler,     fromAddHandler, fromChanges, fromPoll,-    reactimate, Future, reactimate', initial,+    reactimate, Future, reactimate',     changes,     -- $changes     imposeChanges,-    FrameworksMoment(..), execute, liftIOLater,+    execute, liftIOLater,     -- $liftIO     module Control.Monad.IO.Class,-    ++    -- ** Utility functions+    -- | This section collects a few convience functions+    -- built from the core functions.+    newEvent, mapEventIO, newBehavior,+     -- * Running event networks     EventNetwork, actuate, pause,-    -    -- * Utilities-    -- $utilities-    newEvent,-    +     -- * Internal     interpretFrameworks, showNetwork,     ) where@@ -41,7 +45,6 @@ import           Data.IORef import           Reactive.Banana.Combinators import qualified Reactive.Banana.Internal.Combinators as Prim-import           Reactive.Banana.Internal.Phantom import           Reactive.Banana.Types  @@ -61,29 +64,29 @@  * perform /output/ in reaction to events. -In constrast, the functions from "Reactive.Banana.Combinators" allow you +In contrast, the functions from "Reactive.Banana.Combinators" allow you to express the output events in terms of the input events. This expression is called an /event graph/.  An /event network/ is an event graph together with inputs and outputs. To build an event network, describe the inputs, outputs and event graph in the-'Moment' monad +'MomentIO' monad and use the 'compile' function to obtain an event network from that.  To /activate/ an event network, use the 'actuate' function.-The network will register its input event handlers and start +The network will register its input event handlers and start producing output.  A typical setup looks like this:-   + > main = do >   -- initialize your GUI framework >   window <- newWindow >   ... > >   -- describe the event network->   let networkDescription :: forall t. Frameworks t => Moment t ()+>   let networkDescription :: MomentIO () >       networkDescription = do >           -- input: obtain  Event  from functions that register event handlers >           emouse    <- fromAddHandler $ registerMouseEvent window@@ -94,12 +97,12 @@ >           bdie      <- fromPoll       $ randomRIO (1,6) > >           -- express event graph+>           behavior1 <- accumB ... >           let->               behavior1 = accumB ... >               ... >               event15 = union event13 event14->   ->           -- output: animate some event occurences+>+>           -- output: animate some event occurrences >           reactimate $ fmap print event15 >           reactimate $ fmap drawCircle eventCircle >@@ -115,24 +118,24 @@  * Use 'reactimate' to animate /output/ events. +* Use 'compile' to put everything together in an 'EventNetwork's+and use 'actuate' to start handling events.+ -}  {-----------------------------------------------------------------------------     Combinators ------------------------------------------------------------------------------}-singletonsE :: Prim.Event a -> Event t a-singletonsE = E . Prim.mapE (:[])- {- | Output. Execute the 'IO' action whenever the event occurs.   Note: If two events occur very close to each other,-there is no guarantee that the @reactimate@s for one +there is no guarantee that the @reactimate@s for one event will have finished before the ones for the next event start executing. This does /not/ affect the values of events and behaviors, it only means that the @reactimate@ for different events may interleave.-Fortuantely, this is a very rare occurrence, and only happens if+Fortunately, this is a very rare occurrence, and only happens if  * you call an event handler from inside 'reactimate', @@ -140,7 +143,7 @@  In these cases, the @reactimate@s follow the control flow of your event-based framework.-    + Note: An event network essentially behaves like a single, huge callback function. The 'IO' action are not run in a separate thread. The callback function will throw an exception if one of your 'IO' actions@@ -148,16 +151,16 @@ Your event-based framework will have to handle this situation.  -}-reactimate :: Frameworks t => Event t (IO ()) -> Moment t ()-reactimate = M . Prim.addReactimate . Prim.mapE (return . sequence_) . unE+reactimate :: Event (IO ()) -> MomentIO ()+reactimate = MIO . Prim.addReactimate . Prim.mapE return . unE  -- | Output. -- Execute the 'IO' action whenever the event occurs. -- -- This version of 'reactimate' can deal with values obtained -- from the 'changes' function.-reactimate' :: Frameworks t => Event t (Future (IO ())) -> Moment t ()-reactimate' = M . Prim.addReactimate . Prim.mapE (unF . fmap sequence_ . sequence) . unE+reactimate' :: Event (Future (IO ())) -> MomentIO ()+reactimate' = MIO . Prim.addReactimate . Prim.mapE unF . unE   -- | Input,@@ -166,8 +169,8 @@ -- When the event network is actuated, -- this will register a callback function such that -- an event will occur whenever the callback function is called.-fromAddHandler :: Frameworks t => AddHandler a -> Moment t (Event t a)-fromAddHandler = M . fmap singletonsE . Prim.fromAddHandler+fromAddHandler ::AddHandler a -> MomentIO (Event a)+fromAddHandler = MIO . fmap E . Prim.fromAddHandler  -- | Input, -- obtain a 'Behavior' by frequently polling mutable data, like the current time.@@ -177,49 +180,41 @@ -- -- This function is occasionally useful, but -- the recommended way to obtain 'Behaviors' is by using 'fromChanges'.--- +-- -- Ideally, the argument IO action just polls a mutable variable, -- it should not perform expensive computations. -- Neither should its side effects affect the event network significantly.-fromPoll :: Frameworks t => IO a -> Moment t (Behavior t a)-fromPoll = M . fmap B . Prim.fromPoll+fromPoll :: IO a -> MomentIO (Behavior a)+fromPoll = MIO . fmap B . Prim.fromPoll  -- | Input, -- obtain a 'Behavior' from an 'AddHandler' that notifies changes.--- --- This is essentially just an application of the 'stepper' combinator.-fromChanges :: Frameworks t => a -> AddHandler a -> Moment t (Behavior t a)-fromChanges initial changes = stepper initial <$> fromAddHandler changes---- | Output,--- observe the initial value contained in a 'Behavior'. ----- NOTE: To allow for more recursion, the value is returned /lazily/--- and not available for pattern matching immediately.------ If that doesn't work for you, please use 'valueB' instead.-initial :: Behavior t a -> Moment t a-initial = M . Prim.initialBLater . unB+-- This is essentially just an application of the 'stepper' combinator.+fromChanges :: a -> AddHandler a -> MomentIO (Behavior a)+fromChanges initial changes = do+    e <- fromAddHandler changes+    stepper initial e  -- | Output, -- observe when a 'Behavior' changes.--- +-- -- Strictly speaking, a 'Behavior' denotes a value that -- varies /continuously/ in time, -- so there is no well-defined event which indicates when the behavior changes.--- +-- -- Still, for reasons of efficiency, the library provides a way to observe--- changes when the behavior is a step function, for instance as +-- changes when the behavior is a step function, for instance as -- created by 'stepper'. There are no formal guarantees, -- but the idea is that ----- > changes (stepper x e) = return (calm e)+-- > changes =<< stepper x e = return e -- -- Note: The values of the event will not become available -- until event processing is complete. -- It can be used only in the context of 'reactimate''.-changes :: Frameworks t => Behavior t a -> Moment t (Event t (Future a))-changes = return . fmap F . singletonsE . Prim.changesB . unB+changes :: Behavior a -> MomentIO (Event (Future a))+changes = return . E . Prim.mapE F . Prim.changesB . unB  {- $changes @@ -227,7 +222,7 @@ have the additional 'Future' type, then the following code snippet may be useful: -> plainChanges :: Frameworks t => Behavior t a -> Moment t (Event t a)+> plainChanges :: Behavior a -> MomentIO (Event a) > plainChanges b = do >     (e, handle) <- newEvent >     eb <- changes b@@ -248,41 +243,25 @@ -- imposed event. -- -- Note: This function is useful only in very specific circumstances.-imposeChanges :: Frameworks t => Behavior t a -> Event t () -> Behavior t a+imposeChanges :: Behavior a -> Event () -> Behavior a imposeChanges b e = B $ Prim.imposeChanges (unB b) (Prim.mapE (const ()) (unE e)) --- | Dummy type needed to simulate impredicative polymorphism.-newtype FrameworksMoment a-    = FrameworksMoment-    { runFrameworksMoment :: forall t. Frameworks t => Moment t a }--instance Functor FrameworksMoment where-    fmap f (FrameworksMoment x) = FrameworksMoment (fmap f x)-instance Applicative FrameworksMoment where-    pure x = FrameworksMoment (pure x)-    (FrameworksMoment f) <*> (FrameworksMoment x) = FrameworksMoment (f <*> x)-instance Monad FrameworksMoment where-    return x = FrameworksMoment (return x)-    (FrameworksMoment m) >>= g = FrameworksMoment (m >>= runFrameworksMoment . g)--unFM :: FrameworksMoment a -> Moment (FrameworksD,t) a-unFM = runFrameworksMoment- -- | Dynamically add input and output to an existing event network. ----- Note: You can even do 'IO' actions here, but there is no--- guarantee about the order in which they are executed.-execute-    :: Frameworks t-    => Event t (FrameworksMoment a)-    -> Moment t (Event t a)-execute = M-    . fmap singletonsE . Prim.executeE-    . Prim.mapE (fmap last . sequence . map (unM . unFM) )-    . unE+-- Note: You can even do 'IO' actions here,+-- which is useful if you want to register additional event handlers+-- dynamically.+-- However, there is no+-- guarantee about the order in which the actions are executed.+-- If the result 'Event' of this function is garbage collected,+-- it may also happen that the actions are not executed at all.+-- If you want a reliable way to turn events into 'IO' actions+-- use the 'reactimate' and 'reactimate'' functions.+execute :: Event (MomentIO a) -> MomentIO (Event a)+execute = MIO . fmap E . Prim.executeE . Prim.mapE unMIO . unE  -- $liftIO--- +-- -- > liftIO :: Frameworks t => IO a -> Moment t a -- -- Lift an 'IO' action into the 'Moment' monad.@@ -290,17 +269,14 @@ -- | Lift an 'IO' action into the 'Moment' monad, -- but defer its execution until compilation time. -- This can be useful for recursive definitions using 'MonadFix'.-liftIOLater :: Frameworks t => IO () -> Moment t ()-liftIOLater = M . Prim.liftIOLater+liftIOLater :: IO () -> MomentIO ()+liftIOLater = MIO . Prim.liftIOLater  -- | Compile the description of an event network -- into an 'EventNetwork' -- that you can 'actuate', 'pause' and so on.------ Event networks are described in the 'Moment' monad--- and use the 'Frameworks' class constraint.-compile :: (forall t. Frameworks t => Moment t ()) -> IO EventNetwork-compile m = fmap EN $ Prim.compile $ unM (m :: Moment (FrameworksD, t) ())+compile :: MomentIO () -> IO EventNetwork+compile = fmap EN . Prim.compile . unMIO  {-----------------------------------------------------------------------------     Running event networks@@ -339,12 +315,61 @@ showNetwork :: EventNetwork -> IO String showNetwork = Prim.showNetwork . unEN + {-----------------------------------------------------------------------------+    Utilities+------------------------------------------------------------------------------}+-- | Build an 'Event' together with an 'IO' action that can+-- fire occurrences of this event. Variant of 'newAddHandler'.+--+-- This function is mainly useful for passing callback functions+-- inside a 'reactimate'.+newEvent :: MomentIO (Event a, Handler a)+newEvent = do+    (addHandler, fire) <- liftIO $ newAddHandler+    e <- fromAddHandler addHandler+    return (e,fire)++-- | Build a 'Behavior' together with an 'IO' action that can+-- update this behavior with new values.+--+-- Implementation:+--+-- > newBehavior a = do+-- >     (e, fire) <- newEvent+-- >     b         <- stepper a e+-- >     return (b, fire)+newBehavior :: a -> MomentIO (Behavior a, Handler a)+newBehavior a = do+    (e, fire) <- newEvent+    b         <- stepper a e+    return (b, fire)++-- | Build a new 'Event' that contains the result+-- of an IO computation.+-- The input and result events will /not/ be simultaneous anymore,+-- the latter will occur /later/ than the former.+--+-- Please use the 'fmap' for 'Event' if your computation is pure.+--+-- Implementation:+--+-- > mapEventIO f e1 = do+-- >     (e2, handler) <- newEvent+-- >     reactimate $ (\a -> f a >>= handler) <$> e1+-- >     return e2+mapEventIO :: (a -> IO b) -> Event a -> MomentIO (Event b)+mapEventIO f e1 = do+    (e2, handler) <- newEvent+    reactimate $ (\a -> f a >>= handler) <$> e1+    return e2++{-----------------------------------------------------------------------------     Simple use ------------------------------------------------------------------------------} -- | Interpret by using a framework internally. -- Only useful for testing library internals.-interpretFrameworks :: (forall t. Event t a -> Event t b) -> [a] -> IO [[b]]+interpretFrameworks :: (Event a -> Event b) -> [a] -> IO [[b]] interpretFrameworks f xs = do     output                    <- newIORef []     (addHandler, runHandlers) <- newAddHandler@@ -362,38 +387,10 @@  -- | Simple way to write a single event handler with -- functional reactive programming.-interpretAsHandler-    :: (forall t. Event t a -> Event t b)-    -> AddHandler a -> AddHandler b+interpretAsHandler :: (Event a -> Event b) -> AddHandler a -> AddHandler b interpretAsHandler f addHandlerA = AddHandler $ \handlerB -> do     network <- compile $ do         e <- fromAddHandler addHandlerA         reactimate $ handlerB <$> f e     actuate network     return (pause network)---{------------------------------------------------------------------------------    Utilities-------------------------------------------------------------------------------}-{-$utilities--    This section collects a few convenience functions-    for unusual use cases. For instance:-    -    * The event-based framework you want to hook into is poorly designed-    -    * You have to write your own event loop and roll a little event framework---}---- | Build an 'Event' together with an 'IO' action that can --- fire occurrences of this event. Variant of 'newAddHandler'.--- --- This function is mainly useful for passing callback functions--- inside a 'reactimate'.-newEvent :: Frameworks t => Moment t (Event t a, Handler a)-newEvent = do-    (addHandler, fire) <- liftIO $ newAddHandler-    e <- fromAddHandler addHandler-    return (e,fire)

@@ -100,7 +100,7 @@     e <- liftBuild $ do         p <- Prim.unsafeMapIOP (const poll) =<< Prim.alwaysP         return $ Prim.fromPure p-    return $ stepperB a e+    stepperB a e  liftIONow :: IO a -> Moment a liftIONow = liftIO@@ -117,28 +117,51 @@ never       = don'tCache  $ liftBuild $ Prim.neverP unionWith f = liftCached2 $ (liftBuild .) . Prim.unionWithP f filterJust  = liftCached1 $ liftBuild . Prim.filterJustP-accumE x    = liftCached1 $ liftBuild . fmap snd . Prim.accumL x mapE f      = liftCached1 $ liftBuild . Prim.mapP f applyE      = liftCached2 $ \(~(lf,_)) px -> liftBuild $ Prim.applyP lf px  changesB    = liftCached1 $ \(~(lx,px)) -> liftBuild $ Prim.tagFuture lx px --- FIXME: To allow more recursion, create the latch first and--- build the pulse later.-stepperB a  = \c1 -> cache $ do-    p0 <- runCached c1+pureB a = cache $ do+    p <- runCached never+    return (Prim.pureL a, p)+applyB  = liftCached2 $ \(~(l1,p1)) (~(l2,p2)) -> liftBuild $ do+    p3 <- Prim.unionWithP const p1 p2+    let l3 = Prim.applyL l1 l2+    return (l3,p3)+mapB f  = applyB (pureB f)++{-----------------------------------------------------------------------------+    Combinators - accumulation+------------------------------------------------------------------------------}+-- Make sure that the cached computation (Event or Behavior)+-- is executed eventually during this moment.+trim :: Cached Moment a -> Moment (Cached Moment a)+trim b = do+    liftBuildFun Prim.buildLater $ void $ runCached b+    return b++-- Cache a computation at this moment in time+-- and make sure that it is performed in the Build monad eventually+cacheAndSchedule :: Moment a -> Moment (Cached Moment a)+cacheAndSchedule m = ask >>= \r -> liftBuild $ do+    let c = cache (const m r)   -- prevent let-floating!+    Prim.buildLater $ void $ runReaderT (runCached c) r+    return c++stepperB a e = cacheAndSchedule $ do+    p0 <- runCached e     liftBuild $ do         p1    <- Prim.mapP const p0         p2    <- Prim.mapP (const ()) p1         (l,_) <- Prim.accumL a p1         return (l,p2) -pureB a = stepperB a never-applyB  = liftCached2 $ \(~(l1,p1)) (~(l2,p2)) -> liftBuild $ do-    p3 <- Prim.unionWithP const p1 p2-    let l3 = Prim.applyL l1 l2-    return (l3,p3)-mapB f  = applyB (pureB f)+accumE a e1 = cacheAndSchedule $ do+    p0 <- runCached e1+    liftBuild $ do+        (_,p1) <- Prim.accumL a p0+        return p1  {-----------------------------------------------------------------------------     Combinators - dynamic event switching@@ -156,18 +179,6 @@ initialBLater :: Behavior a -> Moment a initialBLater = liftBuildFun Prim.buildLaterReadNow . valueB -trimE :: Event a -> Moment (Moment (Event a))-trimE e = do-    -- make sure that the event is added to the network eventually-    liftBuildFun Prim.buildLater $ void $ runCached e-    return $ return $ e--trimB :: Behavior a -> Moment (Moment (Behavior a))-trimB b = do-    -- make sure that the behavior is added to the network eventually-    liftBuildFun Prim.buildLater $ void $ runCached b-    return $ return $ b- executeP :: Pulse (Moment a) -> Moment (Pulse a) executeP p1 = do     r <- ask@@ -184,15 +195,15 @@     p <- liftBuildFun Prim.buildLaterReadNow $ executeP =<< runCached e     return $ fromPure p -switchE :: Event (Moment (Event a)) -> Event a+switchE :: Event (Event a) -> Event a switchE = liftCached1 $ \p1 -> do-    p2 <- liftBuild $ Prim.mapP (runCached =<<) p1+    p2 <- liftBuild $ Prim.mapP (runCached) p1     p3 <- executeP p2     liftBuild $ Prim.switchP p3 -switchB :: Behavior a -> Event (Moment (Behavior a)) -> Behavior a+switchB :: Behavior a -> Event (Behavior a) -> Behavior a switchB = liftCached2 $ \(l0,p0) p1 -> do-    p2 <- liftBuild $ Prim.mapP (runCached =<<) p1+    p2 <- liftBuild $ Prim.mapP (runCached) p1     p3 <- executeP p2          liftBuild $ do

@@ -1,21 +0,0 @@-{------------------------------------------------------------------------------    reactive-banana-------------------------------------------------------------------------------}-{-# LANGUAGE EmptyDataDecls, FlexibleInstances #-}-module Reactive.Banana.Internal.Phantom (-    -- * Synopsis-    -- | Classes used to constrain the phantom type @t@ in the 'Moment' type.-    -    -- * Documentation-    Frameworks, FrameworksD,-    ) where---- | Class constraint on the type parameter @t@ of the 'Moment' monad.--- --- Indicates that we can add input and output to an event network.-class Frameworks t---- | Data type for discharging the 'Frameworks' constraint.-data FrameworksD--instance Frameworks (FrameworksD,t)

@@ -4,36 +4,36 @@ {-# LANGUAGE BangPatterns #-} module Reactive.Banana.Model (     -- * Synopsis-    -- | Model implementation of the abstract syntax tree.-    -    -- * Description+    -- | Model implementation for learning and testing.++    -- * Overview     -- $model      -- * Combinators     -- ** Data types-    Event, Behavior,+    Time, Event, Behavior, Moment,     -- ** Basic     never, filterJust, unionWith, mapE, accumE, applyE,     stepperB, pureB, applyB, mapB,     -- ** Dynamic event switching-    Moment,-    valueB, trimE, trimB, observeE, switchE, switchB,-        +    valueB, observeE, switchE, switchB,+     -- * Interpretation     interpret,     ) where  import Control.Applicative import Control.Monad (join)+import Data.List     (splitAt)  {-$model -This module contains the model implementation for the primitive combinators-defined "Reactive.Banana.Internal.AST"-which in turn are the basis for the official combinators-documented in "Reactive.Banana.Combinators".+This module reimplements the key FRP types and functions from the module+"Reactive.Banana.Combinators" in a way that is hopefully easier to understand.+Thereby, this model also specifies the semantics of the library.+Of course, the real implementation is much more efficient than this model here. -Look at the source code to make maximal use of this module.+To understand the model in detail, look at the source code! (If there is no link to the source code at every type signature, then you have to run cabal with --hyperlink-source flag.) @@ -42,69 +42,120 @@ Note that this must also hold for recursive and partial definitions (at least in spirit, I'm not going to split hairs over @_|_@ vs @\\_ -> _|_@). -Concerning time and space complexity, the model is not authoritative, however.-Implementations are free to be much more efficient. -}  {------------------------------------------------------------------------------    Basic Combinators+    Types ------------------------------------------------------------------------------}-type Event a    = [Maybe a]              -- should be abstract-data Behavior a = StepperB !a (Event a)  -- should be abstract+-- | The FRP model used in this library is actually a model with continuous time.+--+-- However, it can be shown that this model is observationally+-- equivalent to a particular model with (seemingly) discrete time steps,+-- which is implemented here.+-- Details will be explained elsewhere.+type Time = Int +data Event    a = E Time [Maybe a]  -- starting time, event values (always infinite)+    deriving (Show)+data Behavior a = B Time a [a]      -- starting time, old value, new values (always infinite)+    deriving (Show)+type Moment   a = Time -> a         -- should be abstract++epoch :: Time+epoch = 0++-- | Set the starting time of an Event.+trimE :: Event a -> Moment (Event a)+trimE (E t xs) s+    | s <= t = E s $ replicate (t-s) Nothing ++ xs+    | s >  t = E s $ drop (s-t) xs++-- | Set the starting time of an Event.+trimB :: Behavior a -> Moment (Behavior a)+trimB (B t x xs) s+    | s <= t = B s x $ replicate (t-s) x ++ xs+    | s >  t = B s (last ys) zs+        where+        (ys,zs) = splitAt (s-t) xs++-- Synchronize two entities+syncEE ~ex@(E tx _)   ~ey@(E ty _)   = (ex `trimE` t, ey `trimE` t)+    where t = min tx ty+syncBE ~bx@(B tx _ _) ~ey@(E ty _)   = (bx `trimB` t, ey `trimE` t)+    where t = min tx ty+syncBB ~bx@(B tx _ _) ~by@(B ty _ _) = (bx `trimB` t, by `trimB` t)+    where t = min tx ty++{-----------------------------------------------------------------------------+    Basic Combinators+------------------------------------------------------------------------------} interpret :: (Event a -> Moment (Event b)) -> [Maybe a] -> [Maybe b]-interpret f e = f e 0+interpret f as = zipWith const bs as+    where+    input  = E epoch (as ++ repeat Nothing)+    output = f input (epoch-7) `trimE` epoch+    E _ bs = output+    -- build network before epoch, but start external event at epoch  never :: Event a-never = repeat Nothing+never = E epoch (repeat Nothing)  filterJust :: Event (Maybe a) -> Event a-filterJust = map join+filterJust (E t xs) = E t (map join xs)  unionWith :: (a -> a -> a) -> Event a -> Event a -> Event a-unionWith f = zipWith g+unionWith f ex ey = E t $ zipWith g xs ys     where+    (E t xs, E _ ys) = syncEE ex ey+     g (Just x) (Just y) = Just $ f x y     g (Just x) Nothing  = Just x     g Nothing  (Just y) = Just y     g Nothing  Nothing  = Nothing -mapE f  = applyE (pureB f)+mapE f = applyE (pureB f)  applyE :: Behavior (a -> b) -> Event a -> Event b-applyE _               []     = []-applyE (StepperB f fe) (x:xs) = fmap f x : applyE (step f fe) xs+applyE bf ex = E t $ zipWith (\f x -> fmap f x) (f:fs) xs     where-    step a (Nothing:b) = stepperB a b-    step _ (Just a :b) = stepperB a b--accumE :: a -> Event (a -> a) -> Event a-accumE x []           = []-accumE x (Nothing:fs) = Nothing : accumE x fs-accumE x (Just f :fs) = let y = f x in y `seq` (Just y:accumE y fs) --stepperB :: a -> Event a -> Behavior a-stepperB = StepperB+    (B t f fs, E _ xs) = syncBE bf ex  -- applicative functor-pureB x = stepperB x never+pureB x = B epoch x (repeat x)  applyB :: Behavior (a -> b) -> Behavior a -> Behavior b-applyB (StepperB f fe) (StepperB x xe) =-    stepperB (f x) $ mapE (uncurry ($)) pair+applyB bf bx = B t (f x) $ zipWith ($) fs xs     where-    pair = accumE (f,x) $ unionWith (.) (mapE changeL fe) (mapE changeR xe)-    changeL f (_,x) = (f,x)-    changeR x (f,_) = (f,x)+    (B t f fs, B _ x xs) = syncBB bf bx  mapB f = applyB (pureB f)  {------------------------------------------------------------------------------    Dynamic Event Switching+    Accumulation ------------------------------------------------------------------------------}-type Time     = Int-type Moment a = Time -> a     -- should be abstract+-- Turn first occurence into `Nothing`.+smotherFirst :: Event a -> Event a+smotherFirst (E t (_:xs)) = E t (Nothing:xs) +accumE :: a -> Event (a -> a) -> Moment (Event a)+accumE x e time = E time $ go x xs+    where+    E _ xs = smotherFirst $ e `trimE` time++    go x (Nothing:fs) = Nothing : go x fs+    go x (Just f :fs) = let y = f x in y `seq` (Just y:go y fs)++stepperB :: a -> Event a -> Moment (Behavior a)+stepperB x e time = B time x $ go x xs+    where+    E _ xs = smotherFirst $ e `trimE` time++    go x (Nothing:ys) = x : go x ys+    go x (Just y :ys) = y : go y ys++{-----------------------------------------------------------------------------+    Dynamic Event Switching+------------------------------------------------------------------------------} {- instance Monad Moment where     return  = const@@ -112,41 +163,25 @@ -}  valueB :: Behavior a -> Moment a-valueB (StepperB x _) = return x--trimE :: Event a -> Moment (Moment (Event a))-trimE e = \now -> \later -> drop (later - now) e--trimB :: Behavior a -> Moment (Moment (Behavior a))-trimB b = \now -> \later -> bTrimmed !! (later - now)-    where-    bTrimmed = iterate drop1 b--    drop1 (StepperB x []          ) = StepperB x never-    drop1 (StepperB x (Just y :ys)) = StepperB y ys-    drop1 (StepperB x (Nothing:ys)) = StepperB x ys+valueB b time = x+    where B _ x _ = b `trimB` time  observeE :: Event (Moment a) -> Event a-observeE = zipWith (\time -> fmap ($ time)) [0..]--switchE :: Event (Moment (Event a)) -> Event a-switchE = step never . observeE-    where-    step ys     []           = ys-    step (y:ys) (Nothing:xs) = y : step ys xs -    step (y:ys) (Just zs:xs) = y : step (drop 1 zs) xs-    -- assume that the dynamic events are at least as long as the-    -- switching event+observeE (E t xs) = E t $ zipWith (\time -> fmap ($ time)) [t..] xs -switchB :: Behavior a -> Event (Moment (Behavior a)) -> Behavior a-switchB (StepperB x e) = stepperB x . step e . observeE+switchE :: Event (Event a) -> Event a+switchE (E t xs) = E t $ go t (repeat Nothing) xs     where-    step ys     []                        = ys-    step (y:ys) (Nothing             :xs) =          y : step ys xs -    step (y:ys) (Just (StepperB x zs):xs) = Just value : step (drop 1 zs) xs+    go time (y:ys) (Nothing:es) = y : go (time+1) ys es+    go time (y:ys) (Just e :es) = y : go (time+1) zs es         where-        value = case zs of-            Just z : _ -> z -- new behavior changes right away-            _          -> x -- new behavior stays constant for a while+        E _ zs = e `trimE` (time + 1) +switchB :: Behavior a -> Event (Behavior a) -> Behavior a+switchB b x = B t y $ go t ys es+    where+    (B t y ys, E _ es) = syncBE b x +    go time (y:ys) (Nothing:es) = y : go (time+1) ys es+    go time _      (Just b :es) = z : go (time+1) zs es+        where B _ z zs = b `trimB` (time+1)

@@ -47,7 +47,7 @@ fromPure :: Monad m => a -> Cached m a fromPure = Cached . return --- | Lift an action that is /not/ chached, for instance because it is idempotent.+-- | Lift an action that is /not/ cached, for instance because it is idempotent. don'tCache :: Monad m => m a -> Cached m a don'tCache = Cached 

@@ -36,7 +36,7 @@      let state2 = Network             { nTime    = next time1-            , nOutputs = foldr OB.insert outputs1 os+            , nOutputs = OB.inserts outputs1 os             , nAlwaysP = Just theAlwaysP             }     return (a,state2)

@@ -49,7 +49,7 @@     let actions = OB.inOrder outputs outputs1   -- EvalO actions in proper order         state2  = Network             { nTime    = next time1-            , nOutputs = foldr OB.insert outputs1 os+            , nOutputs = OB.inserts outputs1 os             , nAlwaysP = Just alwaysP             }     return (runEvalOs $ map snd actions, state2)

@@ -9,7 +9,7 @@ import           Data.Functor import qualified Data.HashMap.Strict as Map import           Data.Hashable-import           Data.List+import           Data.List  hiding (insert) import           Data.Maybe import           Data.Ord @@ -25,8 +25,16 @@  -- | Add an element to an ordered bag after all the others. -- Does nothing if the element is already in the bag.-insert :: (Eq a, Hashable a) => a -> OrderedBag a -> OrderedBag a-insert x (OB xs n) = OB (Map.insertWith (\new old -> old) x n xs) (n+1)+insert :: (Eq a, Hashable a) => OrderedBag a -> a -> OrderedBag a+insert (OB xs n) x = OB (Map.insertWith (\new old -> old) x n xs) (n+1)++-- | Add a sequence of elements to an ordered bag.+--+-- The ordering is left-to-right. For example, the head of the sequence+-- comes after all elements in the bag,+-- but before the other elements in the sequence.+inserts :: (Eq a, Hashable a) => OrderedBag a -> [a] -> OrderedBag a+inserts bag xs = foldl insert bag xs  -- | Reorder a list of elements to appear as they were inserted into the bag. -- Remove any elements from the list that do not appear in the bag.

@@ -1,112 +0,0 @@-{------------------------------------------------------------------------------    Reactive Banana-------------------------------------------------------------------------------}-{-# LANGUAGE Rank2Types, ScopedTypeVariables, FlexibleInstances #-}--module Reactive.Banana.Switch (-    -- * Synopsis-    -- | Dynamic event switching.-    -    -- * Moment monad-    Moment, AnyMoment, anyMoment, now,-    -    -- * Dynamic event switching-    trimE, trimB,-    switchE, switchB,-    observeE, valueB,-    -    -- * Identity Functor-    Identity(..),-    ) where--import Control.Applicative-import Control.Monad--import           Reactive.Banana.Combinators-import qualified Reactive.Banana.Internal.Combinators as Prim-import           Reactive.Banana.Types--{------------------------------------------------------------------------------    Constant-------------------------------------------------------------------------------}--- | Identity functor with a dummy argument.--- Unlike 'Data.Functor.Constant',--- this functor is constant in the /second/ argument.--newtype Identity t a = Identity { getIdentity :: a }--instance Functor (Identity t) where-    fmap f (Identity a) = Identity (f a)--{------------------------------------------------------------------------------    Moment-------------------------------------------------------------------------------}--- | Value present at any/every moment in time.-newtype AnyMoment f a = AnyMoment { now :: forall t. Moment t (f t a) }---- | Instance relying on the monad instance.-instance Functor (AnyMoment Identity) where-    fmap = liftM---- | Instance relying on the monad instance.-instance Applicative (AnyMoment Identity) where-    pure = return-    (<*>) = ap--instance Monad (AnyMoment Identity) where-    return x = AnyMoment $ return (Identity x)-    (AnyMoment m) >>= g = AnyMoment $ m >>= \(Identity x) -> now (g x)--instance Functor (AnyMoment Behavior) where-    fmap f (AnyMoment x) = AnyMoment (fmap (fmap f) x)--instance Applicative (AnyMoment Behavior) where-    pure x  = AnyMoment $ return $ pure x-    (AnyMoment f) <*> (AnyMoment x) = AnyMoment $ liftM2 (<*>) f x--instance Functor (AnyMoment Event) where-    fmap f (AnyMoment x) = AnyMoment (fmap (fmap f) x)--anyMoment :: (forall t. Moment t (f t a)) -> AnyMoment f a-anyMoment = AnyMoment--{------------------------------------------------------------------------------    Dynamic event switching-------------------------------------------------------------------------------}--- | Trim an 'Event' to a variable start time.-trimE :: Event t a -> Moment t (AnyMoment Event a)-trimE = M . fmap (\x -> AnyMoment (M $ fmap E x)) . Prim.trimE . unE---- | Trim a 'Behavior' to a variable start time.-trimB :: Behavior t a -> Moment t (AnyMoment Behavior a)-trimB = M . fmap (\x -> AnyMoment (M $ fmap B x)) . Prim.trimB . unB---- | Observe a value at those moments in time where--- event occurrences happen.-observeE :: Event t (AnyMoment Identity a) -> Event t a-observeE = E . Prim.observeE-    . Prim.mapE (sequence . map (fmap getIdentity . unM . now)) . unE---- | Obtain the value of the 'Behavior' at moment @t@.------ NOTE: The value is immediately available for pattern matching.--- Unfortunately, this means that @valueB@ is unsuitable for use--- with value recursion in the 'Moment' monad.------ If you need recursion, please use 'initial' instead.-valueB :: Behavior t a -> Moment t a-valueB = M . Prim.valueB . unB---- | Dynamically switch between 'Event'.-switchE-    :: forall t a. Event t (AnyMoment Event a)-    -> Event t a-switchE = E . Prim.switchE . Prim.mapE (fmap unE . unM . now . last) . unE---- | Dynamically switch between 'Behavior'.-switchB-    :: forall t a. Behavior t a-    -> Event t (AnyMoment Behavior a)-    -> Behavior t a-switchB b e = B $ Prim.switchB (unB b) $-    Prim.mapE (fmap unB . unM . now . last) (unE e)

@@ -23,36 +23,38 @@ main = defaultMain     [ testGroup "Simple"         [ testModelMatch "id"      id-        -- , testModelMatch "never1"  never1+        , testModelMatch "never1"  never1         , testModelMatch "fmap1"   fmap1         , testModelMatch "filter1" filter1         , testModelMatch "filter2" filter2-        , testModelMatch "accumE1" accumE1+        , testModelMatchM "accumE1" accumE1         ]     , testGroup "Complex"-        [ testModelMatch "counter"     counter+        [ testModelMatchM "counter"     counter         , testModelMatch "double"      double         , testModelMatch "sharing"     sharing         , testModelMatch "unionFilter" unionFilter-        , testModelMatch "recursive1"  recursive1-        , testModelMatch "recursive2"  recursive2-        , testModelMatch "recursive3"  recursive3-        , testModelMatch "recursive4a" recursive4a-        , testModelMatch "recursive4b" recursive4b-        , testModelMatch "accumBvsE"   accumBvsE+        , testModelMatchM "recursive1A"  recursive1A+        , testModelMatchM "recursive1B"  recursive1B+        , testModelMatchM "recursive2"  recursive2+        , testModelMatchM "recursive3"  recursive3+        , testModelMatchM "recursive4a" recursive4a+        -- , testModelMatchM "recursive4b" recursive4b+        , testModelMatchM "accumBvsE"   accumBvsE         ]     , testGroup "Dynamic Event Switching"         [ testModelMatch  "observeE_id"         observeE_id-        , testModelMatchM "initialB_immediate"  initialB_immediate-        -- , testModelMatchM "initialB_recursive1" initialB_recursive1-        -- , testModelMatchM "initialB_recursive2" initialB_recursive2-        , testModelMatchM "trimB_recursive"     trimB_recursive+        , testModelMatch  "observeE_stepper"    observeE_stepper+        , testModelMatchM "valueB_immediate"    valueB_immediate+        -- , testModelMatchM "valueB_recursive1" valueB_recursive1+        -- , testModelMatchM "valueB_recursive2" valueB_recursive2         , testModelMatchM "dynamic_apply"       dynamic_apply-        , testModelMatchM "switchE1"            switchE1-        , testModelMatchM "switchB_two"         switchB_two+        , testModelMatch  "switchE1"            switchE1+        , testModelMatchM "switchB1"            switchB1+        , testModelMatchM "switchB2"            switchB2         ]     , testGroup "Regression tests"-        [ testModelMatch "issue79" issue79+        [ testModelMatchM "issue79" issue79         ]     -- TODO:     --  * algebraic laws@@ -105,8 +107,9 @@ filter2   = filterE (>= 3) . fmap (subtract 1) accumE1   = accumE 0 . ((+1) <$) -counter e = applyE (pure const <*> bcounter) e-    where bcounter = accumB 0 $ fmap (\_ -> (+1)) e+counter e = do+    bcounter <- accumB 0 $ fmap (\_ -> (+1)) e+    return $ applyE (pure const <*> bcounter) e  merge e1 e2 = unionWith (++) (list e1) (list e2)     where list = fmap (:[])@@ -120,34 +123,41 @@     e3 = fmap (+1) $ filterE even e1     e2 = fmap (+1) $ filterE odd  e1 -recursive1 e1 = e2-    where-    e2 = applyE b e1-    b  = (+) <$> stepperB 0 e2-recursive2 e1 = e2-    where-    e2 = applyE b e1-    b  = (+) <$> stepperB 0 e3-    e3 = applyE (id <$> b) e1   -- actually equal to e2+recursive1A e1 = mdo+    let e2 = applyE ((+) <$> b) e1+    b <- stepperB 0 e2+    return e2+recursive1B e1 = mdo+    b <- stepperB 0 e2+    let e2 = applyE ((+) <$> b) e1+    return e2 +recursive2 e1 = mdo+    b  <- fmap ((+) <$>) $ stepperB 0 e3+    let e2 = applyE b e1+    let e3 = applyE (id <$> b) e1   -- actually equal to e2+    return e2+ type Dummy = Int  -- Counter that can be decreased as long as it's >= 0 .-recursive3 :: Event Dummy -> Event Int-recursive3 edec = applyE (const <$> bcounter) ecandecrease-    where-    bcounter     = accumB 4 $ (subtract 1) <$ ecandecrease-    ecandecrease = whenE ((>0) <$> bcounter) edec+recursive3 :: Event Dummy -> Moment (Event Int)+recursive3 edec = mdo+    bcounter <- accumB 4 $ (subtract 1) <$ ecandecrease+    let ecandecrease = whenE ((>0) <$> bcounter) edec+    return $ applyE (const <$> bcounter) ecandecrease  -- Recursive 4 is an example reported by Merijn Verstraaten --   https://github.com/HeinrichApfelmus/reactive-banana/issues/56 -- Minimization:-recursive4a :: Event Int -> Event (Bool, Int)-recursive4a eInput = resultB <@ eInput-    where-    resultE     = resultB <@ eInput-    resultB     = (,) <$> focus <*> pureB 0-    focus       = stepperB False $ fst <$> resultE+recursive4a :: Event Int -> Moment (Event (Bool, Int))+recursive4a eInput = mdo+    focus       <- stepperB False $ fst <$> resultE+    let resultE = resultB <@ eInput+    let resultB = (,) <$> focus <*> pureB 0+    return $ resultB <@ eInput++{- -- Full example: recursive4b :: Event Int -> Event (Bool, Int) recursive4b eInput = result <@ eInput@@ -156,79 +166,88 @@     interface = (,) <$> focus <*> cntrVal     (cntrVal, focusChange) = counter eInput focus     result    = stepperB id ((***id) <$> focusChange) <*> interface-    +     filterApply :: Behavior (a -> Bool) -> Event a -> Event a     filterApply b e = filterJust $ sat <$> b <@> e         where sat p x = if p x then Just x else Nothing-    +     counter :: Event Int -> Behavior Bool -> (Behavior Int, Event (Bool -> Bool))     counter input active = (result, not <$ eq)         where         result = accumB 0 $ (+) <$> neq         eq     = filterApply ((==) <$> result) input         neq    = filterApply ((/=) <$> result) input+-}  -- Test 'accumE' vs 'accumB'.-accumBvsE :: Event Dummy -> Event [Int]-accumBvsE e = merge e1 e2-    where-    e1 = accumE 0 ((+1) <$ e)-    e2 = let b = accumB 0 ((+1) <$ e) in applyE (const <$> b) e+accumBvsE :: Event Dummy -> Moment (Event [Int])+accumBvsE e = mdo+    e1 <- accumE 0 ((+1) <$ e) +    b  <- accumB 0 ((+1) <$ e)+    let e2 = applyE (const <$> b) e++    return $ merge e1 e2+ observeE_id = observeE . fmap return -- = id -initialB_immediate e = do-    x <- valueB (stepper 0 e)+observeE_stepper :: Event Int -> Event Int+observeE_stepper e = observeE $ (valueB =<< mb) <$ e+    where+    mb :: Moment (Behavior Int)+    mb = stepper 0 e++valueB_immediate e = do+    x <- valueB =<< stepper 0 e     return $ x <$ e -{-- The following tests can no longer work with 'Build'-being a transformer of the 'IO' monad.-See Note [Recursion].+{-- The following tests would need to use the  valueBLater  combinator -initialB_recursive1 e1 = mdo+valueB_recursive1 e1 = mdo     _ <- initialB b     let b = stepper 0 e1     return $ b <@ e1 -initialB_recursive2 e1 = mdo+valueB_recursive2 e1 = mdo     x <- initialB b-    let bf = const x <$ stepper 0 e1 +    let bf = const x <$ stepper 0 e1     let b  = stepper 0 $ (bf <*> b) <@ e1     return $ b <@ e1 -}  dynamic_apply e = do-    mb <- trimB $ stepper 0 e-    return $ observeE $ (valueB =<< mb) <$ e+    b <- stepper 0 e+    return $ observeE $ (valueB b) <$ e     -- = stepper 0 e <@ e -trimB_recursive e = mdo-    let e2 = observeE $ (valueB =<< mb) <$ e-    mb <- trimB $ stepper 0 e-    return e2+switchE1 e = switchE (e <$ e) -switchE1 e = do-    me <- trimE e-    return $ switchE $ me <$ e-switchB_two e = do-    mb0 <- trimB $ stepper 0 $ filterE even e-    mb1 <- trimB $ stepper 1 $ filterE odd  e-    b0  <- mb0-    let b = switchB b0 $ (\x -> if odd x then mb1 else mb0) <$> e+switchB1 e = do+    b0 <- stepper 0 e+    b1 <- stepper 0 e+    let b = switchB b0 $ (\x -> if odd x then b1 else b0) <$> e     return $ b <@ e +switchB2 e = do+    b0 <- stepper 0 $ filterE even e+    b1 <- stepper 1 $ filterE odd  e+    let b = switchB b0 $ (\x -> if odd x then b1 else b0) <$> e+    return $ b <@ e+ {-----------------------------------------------------------------------------     Regression tests ------------------------------------------------------------------------------}-issue79 :: Event Dummy -> Event String-issue79 inputEvent = outputEvent-    where-    appliedEvent  = (\_ _ -> 1) <$> lastValue <@> inputEvent-    filteredEvent = filterE (const True) appliedEvent-    fmappedEvent  = fmap id (filteredEvent)-    lastValue     = stepper 1 $ fmappedEvent+issue79 :: Event Dummy -> Moment (Event String)+issue79 inputEvent = mdo+    let+        appliedEvent  = (\_ _ -> 1) <$> lastValue <@> inputEvent+        filteredEvent = filterE (const True) appliedEvent+        fmappedEvent  = fmap id (filteredEvent)+    lastValue <- stepper 1 $ fmappedEvent -    outputEvent = unionWith (++)-        (const "filtered event" <$> filteredEvent)-        (((" and " ++) . show) <$> unionWith (+) appliedEvent fmappedEvent)+    let outputEvent = unionWith (++)+            (const "filtered event" <$> filteredEvent)+            (((" and " ++) . show) <$> unionWith (+) appliedEvent fmappedEvent)++    return $ outputEvent 

@@ -46,12 +46,9 @@ unionWith f (E x1 y1) (E x2 y2) = E (X.unionWith f x1 x2) (Y.unionWith f y1 y2) mapE f (E x y)                  = E (X.mapE f x) (Y.mapE f y) applyE ~(B x1 y1) (E x2 y2)     = E (X.applyE x1 x2) (Y.applyE y1 y2)-accumE a (E x y)                = E (X.accumE a x) (Y.accumE a y)  instance Functor Event where fmap = mapE -stepper = stepperB-stepperB a (E x y)              = B (X.stepperB a x) (Y.stepperB a y) pureB a                         = B (X.pureB a) (Y.pureB a) applyB (B x1 y1) (B x2 y2)      = B (X.applyB x1 x2) (Y.applyB y1 y2) mapB f (B x y)                  = B (X.mapB f x) (Y.mapB f y)@@ -65,41 +62,43 @@     (<*>) = ap instance Monad Moment where     return a = M (return a) (return a)-    (M x y) >>= g = M (x >>= fstM . g) (y >>= sndM . g)+    ~(M x y) >>= g = M (x >>= fstM . g) (y >>= sndM . g) instance MonadFix Moment where     mfix f = M (mfix fx) (mfix fy)         where         fx a = let M x _ = f a in x         fy a = let M _ y = f a in y -trimE :: Event a -> Moment (Moment (Event a))-trimE (E x y) = M-    (fmap (fmap ex . mx) $ X.trimE x)-    (fmap (fmap ey . my) $ Y.trimE y)-trimB :: Behavior a -> Moment (Moment (Behavior a))-trimB (B x y) = M-    (fmap (fmap bx . mx) $ X.trimB x)-    (fmap (fmap by . my) $ Y.trimB y) +accumE   a ~(E x y) = M+    (fmap ex $ X.accumE a x)+    (fmap ey $ Y.accumE a y)+stepperB a ~(E x y) = M+    (fmap bx $ X.stepperB a x)+    (fmap by $ Y.stepperB a y)+stepper            = stepperB+ valueB ~(B x y) = M (X.valueB x) (Y.valueB y)  observeE :: Event (Moment a) -> Event a observeE (E x y) = E (X.observeE $ X.mapE fstM x) (Y.observeE $ Y.mapE sndM y) -switchE :: Event (Moment (Event a)) -> Event a+switchE :: Event (Event a) -> Event a switchE (E x y) = E-    (X.switchE $ X.mapE (fstM . fmap fstE) x)-    (Y.switchE $ Y.mapE (sndM . fmap sndE) y)+    (X.switchE $ X.mapE (fstE) x)+    (Y.switchE $ Y.mapE (sndE) y) -switchB :: Behavior a -> Event (Moment (Behavior a)) -> Behavior a+switchB :: Behavior a -> Event (Behavior a) -> Behavior a switchB (B x y) (E xe ye) = B-    (X.switchB x $ X.mapE (fstM . fmap fstB) xe)-    (Y.switchB y $ Y.mapE (sndM . fmap sndB) ye)+    (X.switchB x $ X.mapE (fstB) xe)+    (Y.switchB y $ Y.mapE (sndB) ye)  {-----------------------------------------------------------------------------     Derived combinators ------------------------------------------------------------------------------}-accumB acc = stepperB acc . accumE acc+accumB acc e1 = do+    e2 <- accumE acc e1+    stepperB acc e2 whenE b = filterJust . applyE ((\b e -> if b then Just e else Nothing) <$> b)  infixl 4 <@>, <@

@@ -3,7 +3,9 @@ ------------------------------------------------------------------------------} module Reactive.Banana.Types (     -- | Primitive types.-    Event (..), Behavior (..), Moment (..), Future(..)+    Event(..), Behavior(..),+    Moment(..), MomentIO(..), MonadMoment(..),+    Future(..),     ) where  import Control.Applicative@@ -12,22 +14,30 @@ import Control.Monad.Fix  import qualified Reactive.Banana.Internal.Combinators as Prim-import           Reactive.Banana.Internal.Phantom -{-| @Event t a@ represents a stream of events as they occur in time.-Semantically, you can think of @Event t a@ as an infinite list of values-that are tagged with their corresponding time of occurence,+{-| @Event a@ represents a stream of events as they occur in time.+Semantically, you can think of @Event a@ as an infinite list of values+that are tagged with their corresponding time of occurrence, -> type Event t a = [(Time,a)]+> type Event a = [(Time,a)]++Each pair is called an /event occurrence/.+Note that within a single event stream,+no two event occurrences may happen at the same time.++<<doc/frp-event.png>> -}-newtype Event t a = E { unE :: Prim.Event [a] }+newtype Event a = E { unE :: Prim.Event a } -- Invariant: The empty list `[]` never occurs as event value. -{-| @Behavior t a@ represents a value that varies in time. Think of it as+{-| @Behavior a@ represents a value that varies in time.+Semantically, you can think of it as a function -> type Behavior t a = Time -> a+> type Behavior a = Time -> a++<<doc/frp-behavior.png>> -}-newtype Behavior t a = B { unB :: Prim.Behavior a }+newtype Behavior a = B { unB :: Prim.Behavior a }  -- | The 'Future' monad is just a helper type for the 'changes' function. -- @@ -46,36 +56,62 @@     pure    = F . pure     f <*> a = F $ unF f <*> unF a -{-| The 'Moment' monad denotes a value at a particular /moment in time/.+{-| The 'Moment' monad denotes a /pure/ computation that happens+at one particular moment in time. Semantically, it as a reader monad -This monad is not very interesting, it is mainly used for book-keeping.-In particular, the type parameter @t@ is used-to disallow various unhealthy programs.+> type Moment a = Time -> a -This monad is also used to describe event networks-in the "Reactive.Banana.Frameworks" module.-This only happens when the type parameter @t@-is constrained by the 'Frameworks' class.+When run, the argument tells the time at which this computation happens. -To be precise, an expression of type @Moment t a@ denotes-a value of type @a@ that is observed at a moment in time-which is indicated by the type parameter @t@.+Note that in this context, /time/ really means to /logical time/.+Of course, every calculation on a computer takes some+amount of wall-clock time to complete.+Instead, what is meant here is the time as it relates to+'Event's and 'Behavior's.+We use the fiction that every calculation within the 'Moment'+monad takes zero /logical time/ to perform.+-}+newtype Moment a = M { unM :: Prim.Moment a } +{-| The 'MomentIO' monad is used to add inputs and outputs+to an event network. -}-newtype Moment t a = M { unM :: Prim.Moment a }+newtype MomentIO a = MIO { unMIO :: Prim.Moment a } --- boilerplate class instances-instance Functor (Moment t) where fmap f = M . fmap f . unM+instance MonadIO MomentIO where liftIO = MIO . liftIO -instance Monad (Moment t) where+{-| An instance of the 'MonadMoment' class denotes a computation+that happens at one particular moment in time.++Unlike the 'Moment' monad, it need not be pure anymore.+-}+class Monad m => MonadMoment m where+    liftMoment :: Moment a -> m a++instance MonadMoment Moment   where liftMoment = id+instance MonadMoment MomentIO where liftMoment = MIO . unM++-- boilerplate class instances+instance Functor Moment where fmap f = M . fmap f . unM+instance Monad Moment where     return  = M . return     m >>= g = M $ unM m >>= unM . g--instance Applicative (Moment t) where+instance Applicative Moment where     pure    = M . pure     f <*> a = M $ unM f <*> unM a+instance MonadFix Moment where mfix f = M $ mfix (unM . f) -instance MonadFix (Moment t) where mfix f = M $ mfix (unM . f)+instance Functor MomentIO where fmap f = MIO . fmap f . unMIO+instance Monad MomentIO where+    return  = MIO . return+    m >>= g = MIO $ unMIO m >>= unMIO . g+instance Applicative MomentIO where+    pure    = MIO . pure+    f <*> a = MIO $ unMIO f <*> unMIO a+instance MonadFix MomentIO where mfix f = MIO $ mfix (unMIO . f) -instance Frameworks t => MonadIO (Moment t) where++{-+instance Frameworks t => MonadIO Moment where     liftIO = M . Prim.liftIONow+-}